Add "SimpleT" t
output form
This new output form allows easy piping to the decode function of the tricu executable. Includes a new test for roundtrip evaluation of map, compilation to tree calculus terms, and decoding back to a human readable string.
This commit is contained in:
108
src/Research.hs
108
src/Research.hs
@ -1,14 +1,57 @@
|
||||
module Research where
|
||||
|
||||
import Control.Monad.State
|
||||
import Data.List (intercalate)
|
||||
import Data.Map (Map)
|
||||
import Data.List (intercalate)
|
||||
import Data.Map (Map)
|
||||
import Data.Text (Text, replace)
|
||||
import System.Console.CmdArgs (Data, Typeable)
|
||||
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Text as T
|
||||
|
||||
-- Tree Calculus Types
|
||||
data T = Leaf | Stem T | Fork T T
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
-- Abstract Syntax Tree for tricu
|
||||
data TricuAST
|
||||
= SVar String
|
||||
| SInt Int
|
||||
| SStr String
|
||||
| SList [TricuAST]
|
||||
| SFunc String [String] TricuAST
|
||||
| SApp TricuAST TricuAST
|
||||
| TLeaf
|
||||
| TStem TricuAST
|
||||
| TFork TricuAST TricuAST
|
||||
| SLambda [String] TricuAST
|
||||
| SEmpty
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
-- Tokens from Lexer
|
||||
data LToken
|
||||
= LKeywordT
|
||||
| LIdentifier String
|
||||
| LIntegerLiteral Int
|
||||
| LStringLiteral String
|
||||
| LAssign
|
||||
| LColon
|
||||
| LBackslash
|
||||
| LOpenParen
|
||||
| LCloseParen
|
||||
| LOpenBracket
|
||||
| LCloseBracket
|
||||
| LNewline
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
-- Output formats
|
||||
data CompiledForm = TreeCalculus | FSL | AST | Ternary | Ascii
|
||||
deriving (Show, Data, Typeable)
|
||||
|
||||
-- Environment containing previously evaluated TC terms
|
||||
type Env = Map.Map String T
|
||||
|
||||
-- Tree Calculus Reduction
|
||||
apply :: T -> T -> T
|
||||
apply Leaf b = Stem b
|
||||
apply (Stem a) b = Fork a b
|
||||
@ -79,13 +122,29 @@ toList (Fork x rest) = case toList rest of
|
||||
toList _ = Left "Invalid Tree Calculus list"
|
||||
|
||||
-- Outputs
|
||||
formatResult :: CompiledForm -> T -> String
|
||||
formatResult TreeCalculus = toSimpleT . show
|
||||
formatResult FSL = show
|
||||
formatResult AST = show . toAST
|
||||
formatResult Ternary = toTernaryString
|
||||
formatResult Ascii = toAscii
|
||||
|
||||
toSimpleT :: String -> String
|
||||
toSimpleT s = T.unpack
|
||||
$ replace "Fork" "t"
|
||||
$ replace "Stem" "t"
|
||||
$ replace "Leaf" "t"
|
||||
$ (T.pack s)
|
||||
|
||||
toTernaryString :: T -> String
|
||||
toTernaryString Leaf = "0"
|
||||
toTernaryString (Stem t) = "1" ++ toTernaryString t
|
||||
toTernaryString (Fork t1 t2) = "2" ++ toTernaryString t1 ++ toTernaryString t2
|
||||
|
||||
-- Utility
|
||||
type Env = Map.Map String T
|
||||
toAST :: T -> TricuAST
|
||||
toAST Leaf = TLeaf
|
||||
toAST (Stem a) = TStem (toAST a)
|
||||
toAST (Fork a b) = TFork (toAST a) (toAST b)
|
||||
|
||||
toAscii :: T -> String
|
||||
toAscii tree = go tree "" True
|
||||
@ -101,41 +160,4 @@ toAscii tree = go tree "" True
|
||||
++ go left (prefix ++ (if isLast then " " else "| ")) False
|
||||
++ go right (prefix ++ (if isLast then " " else "| ")) True
|
||||
|
||||
rules :: IO ()
|
||||
rules = putStr $ header
|
||||
++ (unlines $ tcRules)
|
||||
++ (unlines $ haskellRules)
|
||||
++ footer
|
||||
where
|
||||
tcRules :: [String]
|
||||
tcRules =
|
||||
[ "| |"
|
||||
, "| ┌--------- | Tree Calculus | ---------┐ |"
|
||||
, "| | 1. t t a b -> a | |"
|
||||
, "| | 2. t (t a) b c -> a c (b c)| |"
|
||||
, "| | 3a. t (t a b) c t -> a | |"
|
||||
, "| | 3b. t (t a b) c (t u) -> b u | |"
|
||||
, "| | 3c. t (t a b) c (t u v) -> c u v | |"
|
||||
, "| └-------------------------------------┘ |"
|
||||
, "| |"
|
||||
]
|
||||
haskellRules :: [String]
|
||||
haskellRules =
|
||||
[ "| ┌------------------------------ | Haskell | --------------------------------┐ |"
|
||||
, "| | | |"
|
||||
, "| | data T = Leaf | Stem T | Fork TT | |"
|
||||
, "| | | |"
|
||||
, "| | apply :: T -> T -> T | |"
|
||||
, "| | apply Leaf b = Stem b | |"
|
||||
, "| | apply (Stem a) b = Fork a b | |"
|
||||
, "| | apply (Fork Leaf a) _ = a | |"
|
||||
, "| | apply (Fork (Stem a1) a2) b = apply (apply a1 b) (apply a2 b) | |"
|
||||
, "| | apply (Fork (Fork a1 a2) a3) Leaf = a1 | |"
|
||||
, "| | apply (Fork (Fork a1 a2) a3) (Stem u) = apply a2 u | |"
|
||||
, "| | apply (Fork (Fork a1 a2) a3) (Fork u v) = apply (apply a3 u) v | |"
|
||||
, "| └---------------------------------------------------------------------------┘ |"
|
||||
]
|
||||
header :: String
|
||||
header = "┌-------------------- | Rules for evaluating Tree Calculus | -------------------┐\n"
|
||||
footer :: String
|
||||
footer = "└-------------------- | Rules for evaluating Tree Calculus | -------------------┘\n"
|
||||
-- Utility
|
||||
|
Reference in New Issue
Block a user