From 52a6f8656e8a600a2c59fa2802fb46fafb30de45 Mon Sep 17 00:00:00 2001 From: Vladimir Azarov Date: Mon, 12 May 2025 01:51:27 +0200 Subject: Object-like macros --- stream.sml | 159 ++++++++++++++++++++++++------------------------------------- 1 file changed, 63 insertions(+), 96 deletions(-) (limited to 'stream.sml') diff --git a/stream.sml b/stream.sml index 4134293..c41eae7 100644 --- a/stream.sml +++ b/stream.sml @@ -1,82 +1,57 @@ structure Stream :> STREAM = struct type fileId = int type fileOffset = int - type fileInfo = fileId * string * string - type t = fileId * string * fileOffset * string + datatype pos = Pos of string * int * int - type pos = fileId * fileOffset - type ppos = string * int * int option + type t = { + id: fileOffset, + fname: string, + off: fileOffset, + contents: string, - type pposCache = - { id: fileId, fname: string, contents: string, - offset: fileOffset, line: int, col: int } + (* offset * line * col *) + cache: fileOffset * int * int + } + exception EOF exception UngetcError - exception InvalidFileInfo - fun ppos2str (pos, line, col) = + val updateStream = fn z => + let + fun from id fname off contents cache = + { id, fname, off, contents, cache } + fun to f { id, fname, off, contents, cache } = + f id fname off contents cache + in + FRU.makeUpdate5 (from, from, to) + end + z + + fun pos2str (Pos (pos, line, col)) = let val % = Int.toString in - case col of - SOME col => pos ^ ":" ^ %line ^ ":" ^ %col - | NONE => pos ^ ":" ^ %line + pos ^ ":" ^ %line ^ ":" ^ %col end - fun convert (fid, fname, _, contents) = (fid, fname, contents) - - fun calcFilePos (startOff, startPos) contents destOff = - let - fun calc offset (line, col) = - if offset = destOff then - (line, col) - else - calc (offset + 1) (if String.sub (contents, offset) = #"\n" - then (line + 1, 1) else (line, col + 1)) - in - calc startOff startPos - end + fun getcharSure (S as { contents, off, ... }: t) = + (String.sub (contents, off), updateStream S s#off (off + 1) %) - val calcFilePosFromStart = calcFilePos (0, (1, 1)) + fun getchar stream = + (fn (c, s) => (SOME c, s)) $ getcharSure stream handle + Subscript => (NONE, stream) - fun getchar (S as (fid, fname, off, contents)) = - if off < String.size contents then - (SOME $ String.sub (contents, off), (fid, fname, off + 1, contents)) - else - (NONE, S) + fun getcharEx stream = getcharSure stream handle Subscript => raise EOF - fun ungetc (fid, fname, off, contents) = - if off = 0 then + fun ungetc ({ off = 0, ... }: t) = raise UngetcError - else - (fid, fname, off - 1, contents) - - fun getPosAfterCharRead (fid, _, off, _) = (fid, off - 1) - - fun pos2pposWithFI (id, pos) (id', fname, contents) = - if id <> id' then - raise InvalidFileInfo - else - let - val (line, col) = calcFilePosFromStart contents pos - in - (fname, line, SOME col) - end - - fun pos2ppos pos stream = pos2pposWithFI pos (convert stream) + | ungetc stream = updateStream stream u#off (fn off => off - 1) % - fun pposWithoutCol (fname, line, SOME _) = (fname, line, NONE) - | pposWithoutCol (_, _, NONE) = raise Unreachable - - fun getPos (id, _, off, _) = (id, off) - - fun getSubstr startOff endOff (_, _, _, contents) = + fun getSubstr startOff endOff ({ contents, ... }: t) = String.substring (contents, startOff, endOff - startOff) - fun getFname (stream: t) = #2 stream - - val lastUsedId = ref ~1 + fun getFname ({ fname, ... }: t) = fname fun createFromInstream fname instream = let @@ -84,47 +59,39 @@ structure Stream :> STREAM = struct val contents = inputAll instream val () = closeIn instream in - lastUsedId := !lastUsedId + 1; - (!lastUsedId, fname, 0, contents) + { id = 0, fname, off = 0, contents, cache = (0, 1, 1) } end fun create fname = createFromInstream fname (TextIO.openIn fname) - fun isFirstOnLine (_, offset) ((_, _, _, contents) : t) = - let - fun returnToNL ~1 = true - | returnToNL offset = - let - val chr = String.sub (contents, offset) - in - if chr = #"\n" then - true - else if Char.isSpace chr then - returnToNL (offset - 1) - else - false - end - in - returnToNL (offset - 1) - end + fun getOffset ({ off, ... }: t) = off + + fun getPosRaw off (S as { cache = (prevOff, line, col), fname, + contents, ... }: t) = + let + (* + val () = printLn $ "raw: " ^ Int.toString off ^ ", " ^ Int.toString prevOff + *) + + fun calcPos curOff (line, col) = + if curOff = off then + (line, col) + else + calcPos (curOff + 1) + (if String.sub (contents,curOff) = #"\n" then (line + 1, 1) + else (line, col + 1)) + val (line, col) = calcPos prevOff (line, col) + in + assert $ off >= prevOff; + (Pos (fname, line, col), updateStream S s#cache (off, line, col) %) + end + + fun getPos (S as { off, ... }: t) = + getPosRaw off S + + fun EOFpos (S as { contents, ... }: t) = + getPosRaw (String.size contents) S - fun pposCacheInit (id, fname, contents) = - { id, fname, contents, offset = 0, line = 1, col = 1 } - - fun pposCacheAdvance (id, pos) (cache: pposCache) = - if id <> #id cache then - raise Unreachable - else - let - fun ` f = f cache - val p as (line, col) = calcFilePos (` #offset, (` #line, ` #col)) - (` #contents) pos - in - (p, { id = ` #id, fname = ` #fname, contents = ` #contents, - offset = pos, line, col }) - end - - fun pposCacheGetId (cache: pposCache) = #id cache - fun pposCacheGetLine (cache: pposCache) = #line cache - fun pposCacheGetFname (cache: pposCache) = #fname cache + fun getPosAfterChar stream = + getPosRaw (getOffset stream -1) stream end -- cgit v1.2.3