done with parsing logic in functional core

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

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

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

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

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

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

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`.

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

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