From 21512cc979197d0acd4e21c100192a42cdf8ae6e Mon Sep 17 00:00:00 2001 From: Humza Shahid Date: Sat, 12 Jul 2025 03:08:05 +0100 Subject: [PATCH] done with parsing logic in functional core --- fcore/parsing/all-dfa.sml | 35 ++++++++++++++++++++++++ fcore/parsing/int-dfa.sml | 11 +++++--- fcore/parsing/lexer.sml | 52 ++++++++++++++++++++++++++++++++++++ fcore/parsing/parse-grid.sml | 26 ++++++++---------- fcore/parsing/parser.mlb | 16 +++++++++++ fcore/parsing/parser.sml | 35 ++++++++++++++++++++++++ fcore/parsing/parsing.md | 2 ++ fcore/parsing/space-dfa.sml | 2 +- fcore/parsing/tokens.sml | 9 +------ 9 files changed, 160 insertions(+), 28 deletions(-) create mode 100644 fcore/parsing/all-dfa.sml create mode 100644 fcore/parsing/parser.mlb create mode 100644 fcore/parsing/parser.sml diff --git a/fcore/parsing/all-dfa.sml b/fcore/parsing/all-dfa.sml new file mode 100644 index 0000000..79b2b3d --- /dev/null +++ b/fcore/parsing/all-dfa.sml @@ -0,0 +1,35 @@ +structure AllDfa = +struct + type t = {curInt: int, curSpace: int, curBrace: int, lastInt: int, + lastSpace: int, lastBrace: int} + + val initial: t = + { + curInt = IntDfa.start, + curSpace = SpaceDfa.start, + curBrace = BraceDfa.start, + + lastInt = ~1, + lastSpace = ~1, + lastBrace = ~1 + } + + fun areAllDead ({curInt, curSpace, curBrace, ...}: t) = + curInt = 0 andalso curSpace = 0 andalso curBrace = 0 + + fun update (chr, dfa, pos) = + let + val {curInt, curSpace, curBrace, lastInt, lastBrace, lastSpace} = dfa + + val curInt = IntDfa.next (curInt, chr) + val curSpace = SpaceDfa.next (curSpace, chr) + val curBrace = BraceDfa.next (curBrace, chr) + + val lastInt = if IntDfa.isFinal curInt then pos else lastInt + val lastSpace = if SpaceDfa.isFinal curSpace then pos else lastSpace + val lastBrace = if BraceDfa.isFinal curBrace then pos else lastBrace + in + {curInt = curInt, curSpace = curSpace, curBrace = curBrace, lastInt = + lastInt, lastBrace = lastBrace, lastSpace = lastSpace} + end +end diff --git a/fcore/parsing/int-dfa.sml b/fcore/parsing/int-dfa.sml index 55f00ab..1dba3da 100644 --- a/fcore/parsing/int-dfa.sml +++ b/fcore/parsing/int-dfa.sml @@ -1,5 +1,5 @@ structure IntDfa = -MakeDfa (struct +struct val dead = 0 val start = 1 val final = 2 @@ -8,7 +8,7 @@ MakeDfa (struct let val chr = Char.chr i in - if i >= #"0" orelse i < #"9" then + if chr >= #"0" orelse chr < #"9" then final else dead end @@ -17,7 +17,10 @@ MakeDfa (struct val startTable = Vector.tabulate (255, makeStart) val finalTable = startTable - val tables = #[]deadTable, startTable, finalTable + val tables = #[deadTable, startTable, finalTable] + + fun isFinal state = + state = final fun next (state, chr) = let @@ -26,4 +29,4 @@ MakeDfa (struct in Vector.sub (table, idx) end -end) +end diff --git a/fcore/parsing/lexer.sml b/fcore/parsing/lexer.sml index c137368..9e97769 100644 --- a/fcore/parsing/lexer.sml +++ b/fcore/parsing/lexer.sml @@ -1,4 +1,56 @@ structure Lexer = struct + structure T = Tokens + fun validMin (a, b) = + if a = ~1 then b else if b = ~1 then a else Int.min (a, b) + + fun addToken (acc, dfa: AllDfa.t, str, finish) = + let + val {lastInt, lastSpace, lastBrace, ...} = dfa + val min = validMin (lastInt, lastSpace) + val min = validMin (min, lastBrace) + in + if min = ~1 then + NONE + else if min = lastSpace then + SOME (lastSpace, acc) + else + let + val str = String.substring (str, min, finish - min) + in + if min = lastInt then + case Int.fromString str of + SOME int => SOME (lastInt, T.INT int :: acc) + | NONE => NONE + else if min = lastBrace then + if str = "{" then SOME (lastBrace, T.L_BRACE :: acc) + else if str = "}" then SOME (lastBrace, T.R_BRACE :: acc) + else NONE + else + NONE + end + end + + fun scanStep (pos, str, acc, dfa, finish) = + if AllDfa.areAllDead dfa then + addToken (acc, dfa, str, finish) + else + let + val chr = String.sub (str, pos) + val dfa = AllDfa.update (chr, dfa, pos) + in + scanStep (pos - 1, str, acc, dfa, finish) + end + + fun scanLoop (pos, str, acc) = + if pos < 0 then + SOME acc + else + case scanStep (pos, str, acc, AllDfa.initial, pos) of + SOME (pos, acc) => scanLoop (pos - 1, str, acc) + | NONE => NONE + + fun scan str = + scanLoop (String.size str - 1, str, []) end diff --git a/fcore/parsing/parse-grid.sml b/fcore/parsing/parse-grid.sml index 06de46a..4eae661 100644 --- a/fcore/parsing/parse-grid.sml +++ b/fcore/parsing/parse-grid.sml @@ -1,25 +1,26 @@ structure ParseGrid = struct - fun makeGrid (canvasWidth, canvasHeight) = + fun make (canvasWidth, canvasHeight) = let val maxPoints = Int.max (canvasWidth, canvasHeight) - val emptyYAxis = Vector.tabulate (maxPoints, fn _ => {r = 0, g = 0, b = 0, a = 0}) + val emptyYAxis = Vector.tabulate (maxPoints, fn _ => + {r = 0, g = 0, b = 0, a = 0}) in Vector.tabulate (maxPoints, fn _ => emptyYAxis) end local fun loopY (yAxis, x, ex, y, ey, colour) = - if y > ey then yAxis + if y > ey then + yAxis else - let - val yAxis = Vector.update (yAxis, y, colour) - in - loopY (yAxis, x, ex, y + 1, ey, colour) + let val yAxis = Vector.update (yAxis, y, colour) + in loopY (yAxis, x, ex, y + 1, ey, colour) end fun loopX (grid, x, ex, y, ey, colour) = - if x > ex then grid + if x > ex then + grid else let val yAxis = Vector.sub (grid, x) @@ -29,12 +30,7 @@ struct loopX (grid, x + 1, ex, y, ey, colour) end in - fun applyItem (grid, item) = - let - val {x, y, ex, ey, r, g, b, a} = item - val colour = {r = r, g = g, b = b, a = a} - in - loopX (grid, x, ex, y, ey, colour) - end + fun applyItem (grid, x, y, ex, ey, colour) = + loopX (grid, x, ex, y, ey, colour) end end diff --git a/fcore/parsing/parser.mlb b/fcore/parsing/parser.mlb new file mode 100644 index 0000000..fca461c --- /dev/null +++ b/fcore/parsing/parser.mlb @@ -0,0 +1,16 @@ +$(SML_LIB)/basis/basis.mlb + +ann + "allowVectorExps true" +in + space-dfa.sml + int-dfa.sml + brace-dfa.sml + all-dfa.sml +end + +tokens.sml +lexer.sml + +parse-grid.sml +parser.sml diff --git a/fcore/parsing/parser.sml b/fcore/parsing/parser.sml new file mode 100644 index 0000000..098f14a --- /dev/null +++ b/fcore/parsing/parser.sml @@ -0,0 +1,35 @@ +structure Parser = +struct + structure T = Tokens + + fun parseItems (tokens, grid) = + case tokens of + T.L_BRACE :: + T.INT x :: + T.INT y :: + T.INT ex :: + T.INT ey :: + T.INT r :: T.INT g :: T.INT b :: T.INT a :: T.R_BRACE :: tl => + let + val colour = {r = r, g = g, b = b, a = a} + val grid = ParseGrid.applyItem (grid, x, y, ex, ey, colour) + in + parseItems (tl, grid) + end + | _ => SOME (tokens, grid) + + fun parse tokens = + case tokens of + T.INT canvasWidth :: T.INT canvasHeight :: T.L_BRACE :: tl => + let + val grid = ParseGrid.make (canvasWidth, canvasHeight) + in + case parseItems (tl, grid) of + SOME (tokens, grid) => + (case tokens of + [T.R_BRACE] => SOME grid + | _ => NONE) + | NONE => NONE + end + | _ => NONE +end diff --git a/fcore/parsing/parsing.md b/fcore/parsing/parsing.md index 68fc58d..9b121e3 100644 --- a/fcore/parsing/parsing.md +++ b/fcore/parsing/parsing.md @@ -14,4 +14,6 @@ item ::= **{** int int int int int int int int **}** grid ::= int int **{** (item)+ **}** ``` +The first two `int`s in the grid `int int **{** (item)+ **}**` always follow the order: `canvasWidth canvasHeight`. + The large number of `int`s in the `item` always follows the order: `x y ex ey r g b a`. diff --git a/fcore/parsing/space-dfa.sml b/fcore/parsing/space-dfa.sml index bc97120..a030ca1 100644 --- a/fcore/parsing/space-dfa.sml +++ b/fcore/parsing/space-dfa.sml @@ -10,7 +10,7 @@ struct let val chr = Char.chr i in - if chr = #" " orelse chr = #"\n" + if Char.isSpace chr then final else dead end diff --git a/fcore/parsing/tokens.sml b/fcore/parsing/tokens.sml index bd6d619..a5021c7 100644 --- a/fcore/parsing/tokens.sml +++ b/fcore/parsing/tokens.sml @@ -1,8 +1 @@ -structure Tokens = -struct - datatype t = - L_BRACE - | R_BRACE - | INT of int - | X -end +structure Tokens = struct datatype t = L_BRACE | R_BRACE | INT of int end