{- |
Module      : Lexer
Description : Processes preprocessor output into input for the syntactical analysis.
Maintainer  : Christian H. et al.
License     : MIT

The lexer receives the output of the preprocessor -- a list of lists of strings,
where each list represents a single function -- and turns it into a forest of function
graphs. The forest is represented as a list of tuples; each tuple describes a function
graph and contains the function name as a string as well as the function's graph itself.

A single function graph is a list of nodes. A node is a triple containing the following
elements, in this order:

    * Node ID as an Integer. Starts with 1 for each function.
    * The 'IDT.Lexeme' for this node.
    * The node ID of the follower node or 0 if there is no next node.

Note that for valid input, the only node with a follower ID of 0 can be
a node containing the 'IDT.Finish' lexeme. If any other node contains a follower
ID of 0, this is an error (or, in Rail terms, a "crash".
-}
module Lexer (
              -- * Main (pipeline) functions
              process,
              -- * Utility functions
              fromAST, toAST,
              -- * Editor functions
              Direction (N, NE, E, SE, S, SW, W, NW),
              step, parse, IP(IP), dir, posx, posy, count, start, crash, turnaround, junctionturns, lambdadirs , move , current, RelDirection(Forward), funcname
             )
 where

 -- imports --
 import InterfaceDT as IDT
 import ErrorHandling as EH
 import Data.Maybe
 import Data.List
 import AST
 import InstructionPointer
 import qualified Data.Map as Map
 
 -- functions --

 -- |Process preprocessor output into a list of function ASTs.
 --
 --
 -- Raises 'error's on invalid input; see 'ErrorHandling' for a list of error messages.
 process :: IDT.PreProc2Lexer -- ^Preprocessor output (a list of lists of strings; i. e. a list of functions
                              -- in their line representation).
    -> IDT.Lexer2SynAna -- ^A list of ASTs, each describing a single function.
 process (IDT.IPL input) = IDT.ILS $ map (\(x, _) -> processfn x) input

 -- |Process a single function.
 processfn :: IDT.Grid2D -- ^The lines representing the function.
    -> IDT.Graph -- ^A graph of nodes representing the function.
                   -- There may be more functions because of lambdas.
 processfn code
   | Map.size code < 2 = emptyfunc -- oneliners are illegal; follower == 0 will
                               -- lead to a crash, which is what we want.
   | Map.size firstline == 0 || fromJust (Map.lookup 0 firstline) /= '$' = emptyfunc
   | otherwise = (func, finalize (head nxs))
  where
    emptyfunc = (func, [(1, Start, 0)])
    firstline = fromJust (Map.lookup 0 code)
    func = case funcname code of
      (Prelude.Left name) -> name
      (Prelude.Right err) -> error err
    (nxs, _) = nodes code [[(1, Start, 0)]] start

 -- |Get the name of the given function.
 funcname :: IDT.Grid2D -> Either String String
 funcname code
   | isNothing (Map.lookup 0 code) = Prelude.Right EH.strFunctionNameMissing
   | otherwise = helper (tostring 0 line)
  where
   line = fromJust (Map.lookup 0 code)
   tostring i line
     | isNothing (Map.lookup i line) = if i > Map.size line then "" else tostring (i+1) line
     | otherwise = fromJust (Map.lookup i line):tostring (i+1) line
   helper line
     | null line || length (elemIndices '\'' line) < 2 || null fn = Prelude.Right EH.strFunctionNameMissing
     | not $ null $ fn `intersect` "'{}()!" = Prelude.Right EH.strInvalidFuncName
     | otherwise = Prelude.Left fn
    where fn = takeWhile (/='\'') $ tail $ dropWhile (/='\'') line

 -- |Get the nodes for the given function.
 nodes :: IDT.Grid2D  -- ^Lines representing the function.
    -> [[IDT.LexNode]] -- ^Current graph representing the function.
                      -- Initialize with @[[(1, Start, 0, (0, 0, SE))]]@.
    -> IP -- ^Current instruction pointer.
          -- Initialize with @'start'@.
    -> ([[IDT.LexNode]], IP) -- ^Final graph for the function and the new instruction pointer.
 nodes code list ip
  | current code tempip == ' ' = (list, tempip) -- If we are not finished yet, this will
                                                -- automatically lead to a
                                                -- crash since the list will have
                                                -- a leading node without a follower
                                                -- (follower == 0) because it is
                                                -- not modified here at all.
  | endless = (endlesslist, crashfrom ip)
  | otherwise = nodes code newlist newip
   where
      -- This checks if we have e. g. two reflectors that "bounce" the IP between them endlessly.
      endless = count ip > 8 * Map.size (fromJust (Map.lookup 0 code)) * Map.size (fromJust (Map.lookup 0 code))
      endlesslist = (newnode, NOP, newnode) `prepend` update list (path ip) newnode
      newnode = nodecount ip + 1
      prepend newx (x:xs) = (newx:x):xs
      tempip = step code ip
      (newlist, newip) = handle code list tempip

 -- |Helper function for 'nodes': Handle the creation of the next 'PreLexNode'
 -- for the current function.
 handle :: IDT.Grid2D -- ^Line representation of input function.
    -> [[IDT.LexNode]] -- ^Current list of nodes.
    -> IP -- ^Current instruction pointer.
    -> ([[IDT.LexNode]], IP) -- ^New node list and new instruction pointer.
 handle code list ip = helper code list newip lexeme
  where
   (lexeme, newip) = parse code ip
   helper _ list ip Nothing = (list, ip)
   helper code list ip (Just lexeme)
     | knownat > 0 = (update list (path ip) knownat, crashfrom ip)
     | lexeme == Finish = (newlist, crashfrom newip)
     | isattributed lexeme = (merge final, crashfrom finip)
     | otherwise = (newlist, newip)
    where
     knownat = visited ip
     newnode = nodecount ip + 1
     newlist = (newnode, lexeme, 0) `prepend` update list (path ip) newnode
     newip = nodeadd ip newnode
     prepend newx (x:xs) = (newx:x):xs
     isattributed (Junction _) = True
     isattributed (Lambda _) = True
     isattributed _ = False
     (final, finip) = nodes code ([]:tempnodes) (ipmerge trueip tempip)
     (tempnodes, tempip) = nodes code ([]:newlist) (ipmerge falseip newip)
     (falseip, trueip) = if current code ip == '&' then lambdadirs ip else junctionturns code ip
 
 -- |Change the following node of the first (i. e. "last", since the list is reversed)
 -- node in the graph.
 update :: [[IDT.LexNode]] -- ^The graph to operate on.
    -> RelDirection --  ^Turn taken on last Junctions
    -> Int -- ^ID of new follower to set for the first node in the list.
    -> [[IDT.LexNode]] -- ^Resulting graph.
 update list@(x:xs) dir following
  | null x && startsattributed xs && dir == InstructionPointer.Left = helpera list following
  | null x && not (null xs) && startsattributed (tail xs) && dir == InstructionPointer.Right = x:head xs:helper (head (tail xs)) following:tail (tail xs)
  | null x = list
  | otherwise = helper x following:xs
   where
    helper ((node, lexeme, _):xs) following = (node, lexeme, following):xs
    helpera (x:(((node, Junction _, following):xs):xss)) attribute = x:(((node, Junction attribute, following):xs):xss)
    helpera (x:(((node, Lambda _, following):xs):xss)) attribute = x:(((node, Lambda attribute, following):xs):xss)
    startsattributed (((_, Junction _, _):_):_) = True
    startsattributed (((_, Lambda _, _):_):_) = True
    startsattributed _ = False

 -- merges splitted graphs (e.g. Junction)
 -- x3 is the graph until the special node appeared
 -- x2 is the graph that will result in the special attribute
 -- x1 is the graph that will become the follower
 merge :: [[IDT.LexNode]] -> [[IDT.LexNode]]
 merge (x1:x2:x3:xs) = (x1 ++ x2 ++ x3):xs

 -- |Move the instruction pointer a single step.
 step :: IDT.Grid2D -- ^Current function in its line representation.
    -> IP -- ^Current instruction pointer.
    -> IP -- ^New instruction pointer.
 step code ip
   | forward `elem` fval = move ip Forward
   | left `elem` lval && right `elem` rval = crashfrom ip
   | left `elem` lval = move ip InstructionPointer.Left
   | right `elem` rval = move ip InstructionPointer.Right
   | otherwise = crashfrom ip
  where
   (left, forward, right) = adjacent code ip
   (lval, fval, rval) = valids code ip

 -- |Brings it into right order
 finalize :: [IDT.LexNode] -- ^'LexNode's to convert.
    -> [IDT.LexNode] -- ^Resulting list of 'IDT.LexNode's.
 finalize = reverse

-- vim:ts=2 sw=2 et