tricu

An interpreted language for exploring Tree Calculus
Log | Files | Refs | README | LICENSE

Presentation.hs (2529B)

      1 module Runtime.Presentation where
      2 
      3 import Runtime.Tree
      4 import Runtime.Value
      5 import Data.List (intercalate)
      6 import Data.Text (replace)
      7 import qualified Data.Text as T
      8 
      9 -- Output formats
     10 data EvaluatedForm = Tree | FSL | AST | Ternary | Ascii | Decode | Number | StringLit
     11   deriving (Show)
     12 
     13 -- Outputs
     14 formatT :: EvaluatedForm -> T -> String
     15 formatT Tree = toSimpleT . show
     16 formatT FSL          = show
     17 formatT AST          = renderTreeAST
     18 formatT Ternary      = toTernaryString
     19 formatT Ascii        = toAscii
     20 formatT Decode       = decodeResult
     21 formatT Number       = either (\e -> "<not-number: " ++ e ++ ">") show . toNumber
     22 formatT StringLit    = either (\e -> "<not-string: " ++ e ++ ">") show . toString
     23 
     24 toSimpleT :: String -> String
     25 toSimpleT s = T.unpack
     26   $ replace "Fork" "t"
     27   $ replace "Stem" "t"
     28   $ replace "Leaf" "t"
     29   $ T.pack s
     30 
     31 toTernaryString :: T -> String
     32 toTernaryString Leaf = "0"
     33 toTernaryString (Stem t) = "1" ++ toTernaryString t
     34 toTernaryString (Fork t1 t2) = "2" ++ toTernaryString t1 ++ toTernaryString t2
     35 
     36 -- Preserve the historical constructor display without depending on frontend ASTs.
     37 renderTreeAST :: T -> String
     38 renderTreeAST term = go False term
     39   where
     40     go _ Leaf = "TLeaf"
     41     go nested (Stem a) = wrap nested ("TStem " ++ go True a)
     42     go nested (Fork a b) = wrap nested ("TFork " ++ go True a ++ " " ++ go True b)
     43     wrap True text = "(" ++ text ++ ")"
     44     wrap False text = text
     45 
     46 toAscii :: T -> String
     47 toAscii tree = go tree "" True
     48   where
     49     go :: T -> String -> Bool -> String
     50     go Leaf prefix isLast =
     51       prefix ++ (if isLast then "`-- " else "|-- ") ++ "Leaf\n"
     52     go (Stem t) prefix isLast =
     53       prefix ++ (if isLast then "`-- " else "|-- ") ++ "Stem\n"
     54         ++ go t (prefix ++ (if isLast then "    " else "|   ")) True
     55     go (Fork left right) prefix isLast =
     56       prefix ++ (if isLast then "`-- " else "|-- ") ++ "Fork\n"
     57         ++ go left (prefix ++ (if isLast then "    " else "|   ")) False
     58         ++ go right (prefix ++ (if isLast then "    " else "|   ")) True
     59 
     60 decodeResult :: T -> String
     61 decodeResult Leaf = "t"
     62 decodeResult tc =
     63   case (toString tc, toList tc, toNumber tc) of
     64     (Right s, _, _) | all isCommonChar s -> "\"" ++ s ++ "\""
     65     (_, _, Right n) -> show n
     66     (_, Right xs@(_:_), _) -> "[" ++ intercalate ", " (map decodeResult xs) ++ "]"
     67     (_, Right [], _) -> "[]"
     68     _ -> formatT Tree tc
     69   where
     70     isCommonChar c =
     71       let n = fromEnum c
     72       in (n >= 32 && n <= 126)
     73          || n == 9
     74          || n == 10
     75          || n == 13
     76