1#include "share/atspre_staload.hats"
  2#define ATS_DYNLOADFLAG 0
  3staload "libats/libc/SATS/stdio.sats"
  4staload "libats/SATS/stringbuf.sats"
  5staload "libats/DATS/stringbuf.dats"
  6staload "scan.sats"
  7
  8exception ScanErr of ()
  9
 10(*get one character from a file and return the corresponding int*)
 11fun char (manifest: FILEref): int =
 12    fgetc0(manifest)
 13
 14fun isnamec(c: int): bool = 
 15    isalnum(c)           || 
 16    (c = char2int0('_')) || 
 17    (c = char2int0('-')) ||
 18    (c = char2int0('.'))
 19
 20fun isvaluec(c: int): bool = 
 21    (c != char2int0('\n'))
 22
 23fun isliteralc(c: int): bool = 
 24    (c != char2int0('\n')) &&
 25    (c != char2int0 ('$'))
 26
 27fun ispathc(c: int): bool = 
 28    (c != char2int0('\n')) &&
 29    (c != char2int0 (' ')) &&
 30    (c != char2int0 (':'))
 31
 32implement next(s) (*void*) =
 33    ((if s.cur = char2int0('\n') then (
 34        s.line := s.line + 1;
 35        s.col  := 1 )
 36    else s.col := s.col +1);
 37    s.cur := char(s.file))
 38
 39fun read(s: &scanner, allowed: (int) -<fun1> bool): void =
 40    if (s.cur >= 0) && allowed(s.cur) then
 41        let
 42            val c = g1ofg0_char(int2char0(s.cur))
 43        in
 44            if c != '\000' then
 45                let 
 46                    val inserted = stringbuf_insert_char(s.buf, c);
 47                in
 48                    if inserted = 1 then (
 49                        next(s);
 50                        read(s, allowed) ) 
 51                    else $raise ScanErr
 52               end
 53            else (
 54                prerrln!("null at ", s.line,":",s.col);
 55                $raise ScanErr )
 56        end
 57    else ()
 58
 59fun readliteral(s: &scanner): Strptr1 = 
 60let
 61    val () = read(s, isliteralc)
 62in
 63    stringbuf_takeout_all(s.buf)
 64end
 65
 66fun isvarc(c: int): bool =
 67    isnamec(c) &&
 68    c != char2int0('.')
 69
 70(*we may or may not return a stringpart, its like haskell "maybe"*)
 71fun dollar(s: &scanner): Option_vt(stringpart) = 
 72let 
 73    (* assume the scanner is sitting on $ *)
 74    val () = next(s)
 75in  
 76    if s.cur < 0 then ( 
 77        prerrln!("unexpected EOF after '$'");
 78        $raise ScanErr()
 79    ) else 
 80        case+ int2char0(s.cur) of 
 81        | '$'  => (
 82            let val inserted = stringbuf_insert_char(s.buf, '$')
 83            in if inserted = 1 then (next(s); Some_vt(Literal(stringbuf_takeout_all(s.buf))) ) else $raise ScanErr 
 84            end )
 85        | ':'  => (
 86            let val inserted = stringbuf_insert_char(s.buf, ':')
 87            in if inserted = 1 then (next(s); Some_vt(Literal(stringbuf_takeout_all(s.buf))) ) else $raise ScanErr 
 88            end )
 89        | ' '  => (
 90            let val inserted = stringbuf_insert_char(s.buf, ' ')
 91            in if inserted = 1 then (next(s); Some_vt(Literal(stringbuf_takeout_all(s.buf))) ) else $raise ScanErr 
 92            end )
 93        | '\n' => 
 94            let 
 95                val () = next(s)
 96                val () = skipspace(s)
 97            in  None_vt()
 98            end
 99        | '\{' => 
100            let
101               val () = next(s)
102               val () = read(s, isnamec)
103            in
104                if stringbuf_get_size(s.buf) = 0 then (
105                    prerrln!("expected variable name");
106                    $raise ScanErr()
107                ) else (
108                    if s.cur = char2int0('}') then (
109                        next(s);
110                        Some_vt(Variable(stringbuf_takeout_all(s.buf)))
111                    ) else ( 
112                        prerrln!("unclosed variable brace");
113                        $raise ScanErr() )
114                )
115            end
116        | _    =>
117            let
118               val () = read(s, isvarc)
119            in
120                if stringbuf_get_size(s.buf) = 0 then (
121                    prerrln!("expected variable name");
122                    $raise ScanErr
123                ) else
124                    Some_vt(Variable(stringbuf_takeout_all(s.buf)))
125            end
126
127end
128
129fun parts (s: &scanner, collected: List0_vt(stringpart)): List0_vt(stringpart) = 
130    if s.cur < 0 then
131        list_vt_reverse(collected)
132    else
133        case+ int2char0(s.cur) of 
134        | '\n' => list_vt_reverse(collected)
135        | '$'  => ( 
136            case+ dollar(s) of 
137            | ~Some_vt(part) => parts(s, cons_vt(part, collected)) 
138            | ~None_vt()     => parts(s, collected) )
139        | _   => 
140            let
141               val newpart = readliteral(s)
142               val litpart = Literal(newpart)
143               val more    = cons_vt(litpart, collected)
144            in 
145               parts(s, more)
146            end
147    
148implement scanname(s) (*Strptr1*)= 
149let
150    val () = read(s, isnamec)
151in
152    if stringbuf_get_size(s.buf) = 0 then (
153        prerrln!("expected name");
154        $raise ScanErr 
155    ) else 
156        stringbuf_takeout_all(s.buf) 
157end
158
159implement skipspace(s) (*void*) =
160    if (s.cur = char2int0(' ')) then (
161        next(s); skipspace(s))
162    else ()
163
164fun skipcomment(s: &scanner): void =
165    if s.cur < 0 || s.cur = char2int0('\n') then ()
166    else (next(s); skipcomment(s))
167
168implement mktok(text, line, col) (*tok*) =
169    if text = "rule" then (
170        strptr_free(text);
171        TOKrule(line, col)
172    ) else if
173       text = "build" then (
174        strptr_free(text);
175        TOKbuild(line, col)
176    ) else TOKvar(text, line, col)
177
178(* check if the current charachter is the wanted charachter: 
179 * if it is, consume it, if it's not, raise an error *)
180implement scanchar(s, wanted) (*void*) = 
181    if s.cur = wanted then (
182        next(s);
183        skipspace(s)
184    ) else (prerrln!("unexpected token at ",s.line, ":", s.col);
185          $raise ScanErr())
186
187implement scanindent(s) (*bool*) =
188    if s.cur = char2int0(' ') then (
189        skipspace(s);
190        true
191    ) else (false)
192
193(*fun scankeyword(s: &scanner): tok = *)
194implement scankeyword(s) =
195    if s.cur < 0 then (TOKeof(s.line, s.col))
196    else if s.cur = char2int0('\n') then (
197        next(s);
198        scankeyword(s))
199    else if s.cur = char2int0('#')  then (
200        skipcomment(s);
201        scankeyword(s))
202    else if isnamec(s.cur) then
203        let
204            val sline = s.line
205            val scol  = s.col
206            val text  = scanname(s)
207        in
208            mktok(text, sline, scol)
209        end
210    else (prerrln!("expected name at ",s.line, ":", s.col);
211          $raise ScanErr())
212
213implement scanvalue(s) (*List0_vt(stringpart)*) = 
214    parts(s, nil_vt())
215
216implement scanpath(s) = 
217let
218    val () = read(s, ispathc) 
219in
220    stringbuf_takeout_all(s.buf)
221end