{- |
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
step, parse, IP(IP), posx, posy, start, crash, turnaround, junctionturns, lambdadirs , move , current, RelDirection(Forward)
)
where
-- imports --
import InterfaceDT as IDT
import ErrorHandling as EH
import Data.List
import Text.Printf
-- |Modified 'IDT.LexNode' with an additional identifier for nodes
-- to check whether we have circles in the graph.
--
-- The identifier is the last element of the tuple and contains
-- the following sub-elements, in this order:
--
-- * When we visited this node, at which X position did we start to parse its lexeme?
-- * When we visited this node, at which Y position did we start to parse its lexeme?
-- * When we visited this node, from which direction did we come?
type PreLexNode = (Int, IDT.Lexeme, Int, (Int, Int, Direction))
-- |An absolute direction.
data Direction = N | NE | E | SE | S | SW | W | NW deriving (Eq, Show)
-- |A relative direction.
data RelDirection = Left | Forward | Right deriving (Eq, Show)
-- |Instruction pointer consisting of position and an orientation.
data IP =
IP {
-- |Number of processed characters since start of current function.
count :: Int,
-- |Current X position.
posx :: Int,
-- |Current Y position.
posy :: Int,
-- |Current 'Direction'.
dir :: Direction,
-- |Determines if the instruction pointer is on a left or right path of a Junction
path :: RelDirection
}
deriving (Show)
instance Eq IP
where
(==) ipl ipr = posx ipl == posx ipr && posy ipl == posy ipr && dir ipl == dir ipr
-- 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 $ concatMap processfn 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 [x] = [(funcname x, [(1, Start, 0)])] -- oneliners are illegal; follower == 0 will
-- lead to a crash, which is what we want.
processfn code@(x:xs) = if head x /= '$' then [(funcname x, [(1, Start, 0)])] else [(funcname x, finalize (head nxs) [])]
where
(nxs, _) = nodes code [[(1, Start, 0, (0, 0, SE))]] start
-- |Get the name of the given function.
--
-- TODO: Note that this will crash the entire program if there is
-- no function name.
funcname :: String -- ^A line containing the function declaration,
-- e. g. @$ \'main\'@.
-> String -- ^The function name.
funcname line
| null line || length (elemIndices '\'' line) < 2 = error EH.strFunctionNameMissing
| otherwise = takeWhile (/='\'') $ tail $ dropWhile (/='\'') line
-- |Get the nodes for the given function.
nodes :: IDT.Grid2D -- ^Lines representing the function.
-> [[PreLexNode]] -- ^Current graph representing the function.
-- Initialize with @[[(1, Start, 0, (0, 0, SE))]]@.
-> IP -- ^Current instruction pointer.
-- Initialize with @'start'@.
-> ([[PreLexNode]], 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.
| otherwise = if endless then (endlesslist, crash) else nodes code newlist newip
where
-- This checks if we have e. g. two reflectors that "bounce" the IP between them
-- endlessly.
endless = count ip > sum (map length code)
endlesslist = (newnode, NOP, newnode, (-1, -1, SE)) `prepend` update list (path ip) newnode
newnode = sum (map length list) + 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.
-> [[PreLexNode]] -- ^Current list of nodes.
-> IP -- ^Current instruction pointer.
-> ([[PreLexNode]], 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, crash)
| lexeme == Finish = (newlist, crash)
| isjunction lexeme = (merge final, crash)
| otherwise = (newlist, ip{count = 0})
where
knownat = visited list ip
newnode = sum (map length list) + 1
newlist = (newnode, lexeme, 0, (posx ip, posy ip, dir ip)) `prepend` update list (path ip) newnode
prepend newx (x:xs) = (newx:x):xs
isjunction (Junction _) = True
isjunction _ = False
final = fst $ nodes code ([]:temp) trueip
temp = fst $ nodes code ([]:newlist) falseip
(falseip, trueip) = junctionturns code ip
-- |Shift a node by the given amount. May be positive or negative.
-- This is used by 'toGraph' and 'fromGraph' to shift all nodes by 1 or -1, respectively,
-- which is done because the portable text representation of the graph does not include
-- a leading "Start" node with ID 1 -- instead, the node with ID 1 is the first "real"
-- graph node. In other words, when exporting to the text representation, the "Start"
-- node is removed and all other nodes are "shifted" by -1 using this function. When
-- importing, a "Start" node is added and all nodes are shifted by 1.
offset :: Int -- ^Amount to shift node by.
-> IDT.LexNode -- ^Node to operate on.
-> IDT.LexNode -- ^Shifted node.
offset c (node, lexeme, 0) = (node + c, lexeme, 0)
offset c (node, lexeme, following) = (node + c, lexeme, following + c)
-- |Change the following node of the first (i. e. "last", since the list is reversed)
-- node in the graph.
update :: [[PreLexNode]] -- ^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.
-> [[PreLexNode]] -- ^Resulting graph.
update list@(x:xs) dir following
| null x && startsjunction xs && dir == Lexer.Left = helpera list following
| null x && not (null xs) && startsjunction (tail xs) && dir == Lexer.Right = x:head xs:helper (head (tail xs)) following:tail (tail xs)
| null x = list
| otherwise = helper x following:xs
where
helper ((node, lexeme, _, location):xs) following = (node, lexeme, following, location):xs
helpera (x:(((node, _, following, location):xs):xss)) attribute = x:(((node, Junction attribute, following, location):xs):xss)
startsjunction (((_, Junction _, _, _):_):_) = True
startsjunction _ = 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 :: [[PreLexNode]] -> [[PreLexNode]]
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 = crash
| left `elem` lval = move ip Lexer.Left
| right `elem` rval = move ip Lexer.Right
| otherwise = crash
where
(left, forward, right) = adjacent code ip
(lval, fval, rval) = valids code ip
-- |Collect characters until a condition is met while moving in the current direction.
stepwhile :: IDT.Grid2D -- ^Line representation of current function.
-> IP -- ^Current instruction pointer.
-> (Char -> Bool) -- ^Function: Should return True if collection should stop.
-- Gets the current Char as an argument.
-> (String, IP) -- ^Collected characters and the new instruction pointer.
stepwhile code ip fn
| not (fn curchar) = ("", ip)
| not (moveable code ip Forward) = error EH.strMissingClosingBracket
| otherwise = (curchar:resstring, resip)
where
curchar = current code ip
(resstring, resip) = stepwhile code (move ip Forward) fn
-- |Checks if the instruction pointer can be moved without leaving the grid
moveable :: IDT.Grid2D -- ^Line representation of current function
-> IP -- ^Current instruction pointer
-> RelDirection -- ^Where to move to
-> Bool -- ^Whether or not the move could be made
moveable code ip reldir
| null code = False
| newy < 0 || newy >= length code = False
| dir ip `elem` [W, E] && (newx < 0 || newx >= length line) = False
| otherwise = True
where
(newy, newx) = posdir ip reldir
line = code!!newy
-- |Read a string constant and handle escape sequences like \n.
-- Raises an error on invalid escape sequences and badly formatted constants.
readconstant :: IDT.Grid2D -- ^Current function in line representation
-> IP -- ^Current instruction pointer
-> Char -- ^Opening string delimiter, e. g. '['
-> Char -- ^Closing string delimiter, e. g. ']'
-> (String, IP) -- ^The processed constant and the new instruction pointer
readconstant code ip startchar endchar
| curchar == startchar = error EH.strNestedOpenBracket
| curchar == endchar = ("", ip)
| not (moveable code ip Forward) = error EH.strMissingClosingBracket
| otherwise = (newchar:resstring, resip)
where
curchar = current code ip
(newchar, newip) = processescape
(resstring, resip) = readconstant code newip startchar endchar
-- This does the actual work and converts the escape sequence
-- (if there is no escape sequence at the current position, do
-- nothing and pass the current Char through).
processescape :: (Char, IP)
processescape
| curchar /= '\\' = (curchar, move ip Forward)
| esctrail /= '\\' = error EH.strNonSymmetricEscape
| otherwise = case escsym of
'\\' -> ('\\', escip)
'[' -> ('[', escip)
']' -> (']', escip)
'n' -> ('\n', escip)
't' -> ('\t', escip)
_ -> error $ printf EH.strUnhandledEscape escsym
where
[escsym, esctrail] = lookahead code ip 2
-- Points to the character after the trailing backslash
escip = skip code ip 3
-- |Lookahead n characters in the current direction.
lookahead :: IDT.Grid2D -- ^Line representation of current function
-> IP -- ^Current instruction pointer
-> Int -- ^How many characters of lookahead to produce?
-> String -- ^n characters of lookahead
lookahead code ip 0 = []
lookahead code ip n = current code newip : lookahead code newip (n-1)
where
newip = move ip Forward
-- |Skip n characters in the current direction and return the new IP.
skip :: IDT.Grid2D -- ^Line representation of current function
-> IP -- ^Current instruction pointer
-> Int -- ^How many characters to skip? If 1, this is the same
-- as doing "move ip Forward".
-> IP -- ^New instruction pointer
skip code ip n = foldl (\x _ -> move x Forward) ip [1..n]
-- |Move the instruction pointer in a relative direction.
move :: IP -- ^Current instruction pointer.
-> RelDirection -- ^Relative direction to move in.
-> IP -- ^New instruction pointer.
move ip reldir = ip{count = newcount, posx = newx, posy = newy, dir = absolute ip reldir}
where
(newy, newx) = posdir ip reldir
newcount = count ip + 1
-- |Get the 'Char' at the current position of the instruction pointer.
current :: IDT.Grid2D -- ^Line representation of the current function.
-> IP -- ^Current instruction pointer.
-> Char -- ^'Char' at the current IP position.
current code ip = charat code (posy ip, posx ip)
-- |Get the 'Char' at the next position of the instruction pointer
next :: IDT.Grid2D -> IP -> Char
next code ip = current code $ move ip Forward
-- |Get adjacent (left secondary, primary, right secondary)
-- symbols for the current IP position.
adjacent :: IDT.Grid2D -- ^Line representation of the current function.
-> IP -- ^Current instruction pointer.
-> (Char, Char, Char) -- ^Adjacent (left secondary, primary, right secondary) symbols
adjacent code ip
| current code ip `elem` turnblocked = (' ', charat code (posdir ip Forward), ' ')
| otherwise = (charat code (posdir ip Lexer.Left), charat code (posdir ip Forward), charat code (posdir ip Lexer.Right))
-- returns instruction pointers turned for (False, True)
junctionturns :: IDT.Grid2D -> IP -> (IP, IP)
junctionturns code ip = tuplecheck $ tuplemove $ addpath $ turning (current code ip) ip
where
tuplecheck (ipl, ipr) = (if current code ipl == primary ipl then ipl else crash, if current code ipr == primary ipr then ipr else crash)
tuplemove (ipl, ipr) = (move ipl Forward, move ipr Forward)
addpath (ipl, ipr) = (ipl{path = Lexer.Left}, ipr{path = Lexer.Right})
turning char ip
| char == '<' = case dir ip of
E -> (ip{dir = NE}, ip{dir = SE})
SW -> (ip{dir = SE}, ip{dir = W})
NW -> (ip{dir = W}, ip{dir = NE})
_ -> (crash, crash)
| char == '>' = case dir ip of
W -> (ip{dir = SW}, ip{dir = NW})
SE -> (ip{dir = E}, ip{dir = SW})
NE -> (ip{dir = NW}, ip{dir = E})
_ -> (crash, crash)
| char == '^' = case dir ip of
S -> (ip{dir = SE}, ip{dir = SW})
NE -> (ip{dir = N}, ip{dir = SE})
NW -> (ip{dir = SW}, ip{dir = N})
_ -> (crash, crash)
| char == 'v' = case dir ip of
N -> (ip{dir = NW}, ip{dir = NE})
SE -> (ip{dir = NE}, ip{dir = S})
SW -> (ip{dir = S}, ip{dir = NW})
_ -> (crash, crash)
| otherwise = (ip, ip)
-- returns insturction pointers turned for (Lambda, Reflected)
lambdadirs :: IP -> (IP, IP)
lambdadirs ip = (ip, turnaround ip)
-- make a 180° turn on instruction pointer
turnaround :: IP -> IP
turnaround ip = ip{dir = absolute ip{dir = absolute ip{dir = absolute ip{dir = absolute ip Lexer.Left} Lexer.Left} Lexer.Left} Lexer.Left}
-- |Returns 'Char' at given position, @\' \'@ if position is invalid.
charat :: IDT.Grid2D -- ^Line representation of current function.
-> (Int, Int) -- ^Position as (x, y) coordinate.
-> Char -- ^'Char' at given position.
charat code _ | null code = ' '
charat code (y, _) | y < 0 || y >= length code = ' '
charat code (y, x)
| x < 0 || x >= length line = ' '
| otherwise = line!!x
where
line = code!!y
-- |Get the position of a specific heading.
posdir :: IP -- ^Current instruction pointer.
-> RelDirection -- ^Current relative direction.
-> (Int, Int) -- ^New position that results from the given relative movement.
posdir ip reldir = posabsdir ip (absolute ip reldir)
-- |Get the position of an absolute direction.
posabsdir :: IP -- ^Current instruction pointer.
-> Direction -- ^Current absolute direction.
-> (Int, Int) -- ^New position that results from the given absolute movement.
posabsdir ip N = (posy ip - 1, posx ip)
posabsdir ip NE = (posy ip - 1, posx ip + 1)
posabsdir ip E = (posy ip, posx ip + 1)
posabsdir ip SE = (posy ip + 1, posx ip + 1)
posabsdir ip S = (posy ip + 1, posx ip)
posabsdir ip SW = (posy ip + 1, posx ip - 1)
posabsdir ip W = (posy ip, posx ip - 1)
posabsdir ip NW = (posy ip - 1, posx ip - 1)
-- |Convert a relative direction into a relative one.
absolute :: IP -- ^Current instruction pointer.
-> RelDirection -- ^Relative direction to convert.
-> Direction -- ^Equivalent absolute direction.
absolute x Forward = dir x
absolute (IP {dir=N}) Lexer.Left = NW
absolute (IP {dir=N}) Lexer.Right = NE
absolute (IP {dir=NE}) Lexer.Left = N
absolute (IP {dir=NE}) Lexer.Right = E
absolute (IP {dir=E}) Lexer.Left = NE
absolute (IP {dir=E}) Lexer.Right = SE
absolute (IP {dir=SE}) Lexer.Left = E
absolute (IP {dir=SE}) Lexer.Right = S
absolute (IP {dir=S}) Lexer.Left = SE
absolute (IP {dir=S}) Lexer.Right = SW
absolute (IP {dir=SW}) Lexer.Left = S
absolute (IP {dir=SW}) Lexer.Right = W
absolute (IP {dir=W}) Lexer.Left = SW
absolute (IP {dir=W}) Lexer.Right = NW
absolute (IP {dir=NW}) Lexer.Left = W
absolute (IP {dir=NW}) Lexer.Right = N
-- |Get the next lexeme at the current position.
parse :: IDT.Grid2D -- ^Line representation of current function.
-> IP -- ^Current instruction pointer.
-> (Maybe IDT.Lexeme, IP) -- ^Resulting lexeme (if any) and
-- the new instruction pointer.
parse code ip = junctioncheck $ case current code ip of
'b' -> (Just Boom, ip)
'e' -> (Just EOF, ip)
'i' -> (Just Input, ip)
'o' -> (Just Output, ip)
'u' -> (Just Underflow, ip)
'?' -> (Just RType, ip)
'a' -> (Just Add1, ip)
'd' -> (Just Divide, ip)
'm' -> (Just Multiply, ip)
'r' -> (Just Remainder, ip)
's' -> (Just Subtract, ip)
'0' -> (Just (Constant "0"), ip)
'1' -> (Just (Constant "1"), ip)
'2' -> (Just (Constant "2"), ip)
'3' -> (Just (Constant "3"), ip)
'4' -> (Just (Constant "4"), ip)
'5' -> (Just (Constant "5"), ip)
'6' -> (Just (Constant "6"), ip)
'7' -> (Just (Constant "7"), ip)
'8' -> (Just (Constant "8"), ip)
'9' -> (Just (Constant "9"), ip)
'c' -> (Just Cut, ip)
'p' -> (Just Append, ip)
'z' -> (Just Size, ip)
'n' -> (Just Nil, ip)
':' -> (Just Cons, ip)
'~' -> (Just Breakup, ip)
'f' -> (Just (Constant "0"), ip)
't' -> (Just (Constant "1"), ip)
'g' -> (Just Greater, ip)
'q' -> (Just Equal, ip)
'$' -> (Just Start, ip)
'#' -> (Just Finish, ip)
'.' -> (Just NOP, ip)
'v' -> (Just (Junction 0), ip)
'^' -> (Just (Junction 0), ip)
'>' -> (Just (Junction 0), ip)
'<' -> (Just (Junction 0), ip)
'[' -> let (string, newip) = readconstant code tempip '[' ']' in (Just (Constant string), newip)
']' -> let (string, newip) = readconstant code tempip ']' '[' in (Just (Constant string), newip)
'{' -> let (string, newip) = stepwhile code tempip (/= '}') in (Just (Call string), newip)
'}' -> let (string, newip) = stepwhile code tempip (/= '{') in (Just (Call string), newip)
'(' -> let (string, newip) = stepwhile code tempip (/= ')') in (pushpop string, newip)
')' -> let (string, newip) = stepwhile code tempip (/= '(') in (pushpop string, newip)
_ -> (Nothing, turn (current code ip) ip)
where
junctioncheck (Nothing, ip)
| current code ip `elem` "+x*" && next code ip `elem` "v^<>" = (Nothing, crash)
| forward == ' ' && (left == current code ip || right == current code ip) = (Nothing, crash)
| forward == ' ' && (left `elem` "v^<>+x*" || right `elem` "v^<>+x*") = (Nothing, crash)
| otherwise = (Nothing, ip)
where
(left, forward, right) = adjacent code ip
junctioncheck (lexeme, ip)
| next code ip `elem` "v^<>" = (lexeme, crash)
| otherwise = (lexeme, ip)
turn '@' ip = turnaround ip
turn '|' ip
| dir ip `elem` [NW, N, NE] = ip{dir = N}
| dir ip `elem` [SW, S, SE] = ip{dir = S}
turn '/' ip
| dir ip `elem` [N, NE, E] = ip{dir = NE}
| dir ip `elem` [S, SW, W] = ip{dir = SW}
turn '-' ip
| dir ip `elem` [NE, E, SE] = ip{dir = E}
| dir ip `elem` [SW, S, NW] = ip{dir = W}
turn '\\' ip
| dir ip `elem` [W, NW, N] = ip{dir = NW}
| dir ip `elem` [E, SE, S] = ip{dir = SE}
turn _ ip = ip
tempip = move ip Forward
pushpop string
| string == "" = Just (Push string)
| head string == '!' && last string == '!' = Just (Pop (tail $ init string))
| otherwise = Just (Push string)
-- |Get ID of the node that has been already visited using the current IP
-- (direction and coordinates).
visited :: [[PreLexNode]] -- ^List of nodes to check.
-> IP -- ^Instruction pointer to use.
-> Int -- ^ID of visited node or 0 if none.
visited [] _ = 0
visited (x:xs) ip = let res = helper x ip in if res > 0 then res else visited xs ip
where
helper [] _ = 0
helper ((id, _, _, (x, y, d)):xs) ip
| x == posx ip && y == posy ip && d == dir ip = id
| otherwise = helper xs ip
-- |Convert a list of 'PreLexNode's into a list of 'IDT.LexNode's.
finalize :: [PreLexNode] -- ^'PreLexNode's to convert.
-> [IDT.LexNode] -- ^Accumulator. Initialize with @[]@.
-> [IDT.LexNode] -- ^Resulting list of 'IDT.PreLexNode's.
finalize [] result = result
finalize ((node, lexeme, following, _):xs) result = finalize xs ((node, lexeme, following):result)
-- |Initial value for the instruction pointer at the start of a function.
start :: IP
start = IP 0 0 0 SE Forward
-- |An instruction pointer representing a "crash" (fatal error).
crash :: IP
crash = IP 0 (-1) (-1) NW Forward
-- what is the primary rail for the given direction?
-- mainly used to check if junctions turn away correctly
primary :: IP -> Char
primary ip
| dir ip `elem` [N, S] = '|'
| dir ip `elem` [E, W] = '-'
| dir ip `elem` [NE, SW] = '/'
| dir ip `elem` [NW, SE] = '\\'
-- |Return valid chars for movement depending on the current direction.
valids :: IDT.Grid2D -- ^Line representation of current function.
-> IP -- ^Current instruction pointer.
-> (String, String, String) -- ^Tuple consisting of:
--
-- * Valid characters for movement to the (relative) left.
-- * Valid characters for movement in the (relative) forward direction.
-- * Valid characters for movement to the (relative) right.
valids code ip = tripleinvert (commandchars ++ dirinvalid ip ++ finvalid ip{dir = absolute ip Lexer.Left}, finvalid ip, commandchars ++ dirinvalid ip ++ finvalid ip{dir = absolute ip Lexer.Right})
where
tripleinvert (l, f, r) = (filter (`notElem` l) everything, filter (`notElem` f) everything, filter (`notElem` r) everything)
finvalid ip = dirinvalid ip ++ crossinvalid ip -- illegal to move forward
dirinvalid ip -- illegal without crosses
| dir ip `elem` [E, W] = "|"
| dir ip `elem` [NE, SW] = "\\"
| dir ip `elem` [N, S] = "-"
| dir ip `elem` [NW, SE] = "/"
| otherwise = ""
crossinvalid ip -- illegal crosses
| dir ip `elem` [N, E, S, W] = "x"
| otherwise = "+"
cur = current code ip
everything = "+\\/x|-" ++ always
always = "^v<>*@{}[]()" ++ commandchars
-- list of chars that are commands in rail
commandchars :: String
commandchars = "abcdefgimnopqrstuz:~0123456789?#"
-- list of chars which do not allow any turning
turnblocked :: String
turnblocked = "$*+x" ++ commandchars
-- |Convert a graph/AST into a portable text representation.
-- See also 'fromGraph'.
fromAST :: IDT.Lexer2SynAna -- ^Input graph/AST/forest.
-> String -- ^Portable text representation of the AST:
--
-- Each function is represented by its own section. A section has a header
-- and content; it continues either until the next section, a blank line or
-- the end of the file, whichever comes first.
--
-- A section header consists of a single line containing the name of the function,
-- enclosed in square brackets, e. g. @[function_name]@. There cannot be any whitespace
-- before the opening bracket.
--
-- The section content consists of zero or more non-blank lines containing exactly
-- three records delimited by a semicolon @;@. Each line describes a node and contains
-- the following records, in this order:
--
-- * The node ID (numeric), e. g. @1@.
-- * The Rail lexeme, e. g. @o@ or @[constant]@ etc. Note that track lexemes like
-- @-@ or @+@ are not included in the graph. Multi-character lexemes like constants
-- may include semicolons, so you need to parse them correctly! In other words, you need
-- to take care of lines like @1;[some ; constant];2@.
-- * Node ID of the follower node, e. g. @2@. May be @0@ if there is no next node.
fromAST (IDT.ILS graph) = unlines $ map fromGraph graph
-- |Convert a portable text representation of a graph into a concrete graph representation.
-- See also 'toGraph'. See 'fromAST' for a specification of the portable text representation.
toAST :: String -- ^Portable text representation. See 'fromAST'.
-> IDT.Lexer2SynAna -- ^Output graph.
toAST input = IDT.ILS (map toGraph $ splitfunctions input)
-- |Convert an 'IDT.Graph' for a single function to a portable text representation.
-- See 'fromAST' for a specification of the representation.
--
-- TODO: Currently, this apparently crashes the program on invalid input. More sensible error handling?
-- At least a nice error message would be nice.
fromGraph :: IDT.Graph -- ^Input graph.
-> String -- ^Text representation.
fromGraph (funcname, nodes) = unlines $ ("["++funcname++"]"):tail (map (fromLexNode . offset (-1)) nodes)
where
fromLexNode :: IDT.LexNode -> String
fromLexNode (id, lexeme, follower) = show id ++ ";" ++ fromLexeme lexeme ++ ";" ++ show follower ++ optional lexeme
fromLexeme :: IDT.Lexeme -> String
fromLexeme Boom = "b"
fromLexeme EOF = "e"
fromLexeme Input = "i"
fromLexeme Output = "o"
fromLexeme Underflow = "u"
fromLexeme RType = "?"
fromLexeme (Constant string) = "["++string++"]"
fromLexeme (Push string) = "("++string++")"
fromLexeme (Pop string) = "(!"++string++"!)"
fromLexeme (Call string) = "{"++string++"}"
fromLexeme Add1 = "a"
fromLexeme Divide = "d"
fromLexeme Multiply = "m"
fromLexeme Remainder = "r"
fromLexeme Subtract = "s"
fromLexeme Cut = "c"
fromLexeme Append = "p"
fromLexeme Size = "z"
fromLexeme Nil = "n"
fromLexeme Cons = ":"
fromLexeme Breakup = "~"
fromLexeme Greater = "g"
fromLexeme Equal = "q"
fromLexeme Start = "$"
fromLexeme Finish = "#"
fromLexeme (Junction _) = "v"
fromLexeme NOP = "."
optional (Junction follow) = ';' : show follow
optional _ = ";0"
-- |Split a portable text representation of multiple function graphs (a forest) into separate
-- text representations of each function graph.
splitfunctions :: String -- ^Portable text representation of the forest.
-> [[String]] -- ^List of lists, each being a list of lines making up a separate function graph.
splitfunctions = groupBy (\_ y -> null y || head y /= '[') . filter (not . null) . lines
-- |Convert a portable text representation of a single function into an 'IDT.Graph'.
-- Raises 'error's on invalid input (see 'ErrorHandling').
toGraph :: [String] -- ^List of lines making up the text representation of the function.
-> IDT.Graph -- ^Graph describing the function.
toGraph lns = (init $ tail $ head lns, (1, Start, 2):map (offset 1) (nodes $ tail lns))
where
nodes [] = []
nodes (ln:lns) = (read id, fixedlex, read follower):nodes lns
where
(id, other) = span (/=';') ln
(lex, ip) = parse [other] $ IP 0 1 0 E Forward
(follower, attribute) = span (/=';') (drop (2 + posx ip) other)
fixedlex
| isJunction lex = Junction (read $ tail attribute)
| otherwise = fromJust lex
fromJust Nothing = error $ printf EH.shrLineNoLexeme ln
fromJust (Just x) = x
isJunction (Just (Junction _)) = True
isJunction _ = False
-- vim:ts=2 sw=2 et