sml-projects/fcore/parser/parser.sml

structure Parser =
struct
  structure T = Tokens

  fun parseItem (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
          SOME (tl, grid)
        end
    | _ => NONE

  (* note to be careful of:
   * - startParseItems returns NONE if there are no items found,
   * because we have not found a single item yet. 
   *
   * - loopParseItems returns SOME if there are no items found,
   * because this function is called after we have parsed at least one item.
   * *)
  fun loopParseItems (tokens, grid) =
    case parseItem (tokens, grid) of
      SOME (tokens, grid) => loopParseItems (tokens, grid)
    | NONE => SOME (tokens, grid)

  fun startParseItems (tokens, grid) =
    case parseItem (tokens, grid) of
      SOME (tokens, grid) => loopParseItems (tokens, grid)
    | NONE => NONE

  fun parseLayers (tokens, canvasWidth, canvasHeight, tree, counter) =
    case tokens of
      T.L_BRACKET :: tl =>
        let
          val grid = ParseGrid.make (canvasWidth, canvasHeight)
        in
          case startParseItems (tl, grid) of
            SOME (T.R_BRACKET :: tl, grid) =>
              let val tree = LayerTree.insert (counter, grid, tree)
              in parseLayers (tl, canvasWidth, canvasHeight, tree, counter + 1)
              end
          | SOME _ => NONE
          | NONE => (tokens, tree)
        end
    | _ => (tokens, tree)

  fun parse string =
    case Lexer.scan string of
      SOME tokens =>
        (case tokens of
           T.INT canvasWidth :: T.INT canvasHeight :: T.L_BRACE :: tl =>
             let
               val maxSide = Int.max (canvasWidth, canvasHeight)
               val tree = LayerTree.init maxSide
               val (tokens, tree) = parseLayers
                 (tl, canvasWidth, canvasHeight, tree, 1)
             in
               case tokens of
                 [T.R_BRACE] => SOME (canvasWidth, canvasHeight, tree)
               | _ => NONE
             end
         | _ => NONE)
    | NONE => NONE
end