Stop using to/of conventions backwards
This commit is contained in:
parent
2e539eb545
commit
e376d13a93
@ -48,9 +48,9 @@ evalAST env term = case term of
|
||||
TStem t -> Stem (evalAST env t)
|
||||
TFork t1 t2 -> Fork (evalAST env t1) (evalAST env t2)
|
||||
SApp t1 t2 -> apply (evalAST env t1) (evalAST env t2)
|
||||
SStr str -> toString str
|
||||
SInt num -> toNumber num
|
||||
SList elems -> toList (map (evalAST Map.empty) elems)
|
||||
SStr str -> ofString str
|
||||
SInt num -> ofNumber num
|
||||
SList elems -> ofList (map (evalAST Map.empty) elems)
|
||||
SFunc name args body ->
|
||||
error $ "Unexpected function definition " ++ name
|
||||
++ " in evalAST; define via evalSingle."
|
||||
|
@ -74,10 +74,10 @@ parseVarWithoutAssignment = do
|
||||
parseLambda :: Parser SaplingAST
|
||||
parseLambda = between (satisfy (== LOpenParen)) (satisfy (== LCloseParen)) $ do
|
||||
satisfy (== LBackslash)
|
||||
param <- satisfy isIdentifier
|
||||
rest <- many (satisfy isIdentifier)
|
||||
param <- satisfy isIdentifier
|
||||
rest <- many (satisfy isIdentifier)
|
||||
satisfy (== LColon)
|
||||
body <- parseLambdaExpression
|
||||
body <- parseLambdaExpression
|
||||
let nestedLambda = foldr (\v acc -> SLambda [v] acc) body (map getIdentifier rest)
|
||||
return (SLambda [getIdentifier param] nestedLambda)
|
||||
|
||||
|
@ -33,10 +33,10 @@ repl env = runInputT defaultSettings (loop env)
|
||||
loop newEnv
|
||||
|
||||
decodeResult :: T -> String
|
||||
decodeResult tc = case ofNumber tc of
|
||||
decodeResult tc = case toNumber tc of
|
||||
Right num -> show num
|
||||
Left _ -> case ofString tc of
|
||||
Left _ -> case toString tc of
|
||||
Right str -> "\"" ++ str ++ "\""
|
||||
Left _ -> case ofList tc of
|
||||
Left _ -> case toList tc of
|
||||
Right list -> "[" ++ intercalate ", " (map decodeResult list) ++ "]"
|
||||
Left _ -> ""
|
||||
|
@ -51,41 +51,41 @@ _not :: T
|
||||
_not = Fork (Fork _true (Fork Leaf _false)) Leaf
|
||||
|
||||
-- Marshalling
|
||||
toString :: String -> T
|
||||
toString str = toList (map toNumber (map fromEnum str))
|
||||
ofString :: String -> T
|
||||
ofString str = ofList (map ofNumber (map fromEnum str))
|
||||
|
||||
toNumber :: Int -> T
|
||||
toNumber 0 = Leaf
|
||||
toNumber n =
|
||||
ofNumber :: Int -> T
|
||||
ofNumber 0 = Leaf
|
||||
ofNumber n =
|
||||
Fork
|
||||
(if odd n then Stem Leaf else Leaf)
|
||||
(toNumber (n `div` 2))
|
||||
(ofNumber (n `div` 2))
|
||||
|
||||
toList :: [T] -> T
|
||||
toList [] = Leaf
|
||||
toList (x:xs) = Fork x (toList xs)
|
||||
ofList :: [T] -> T
|
||||
ofList [] = Leaf
|
||||
ofList (x:xs) = Fork x (ofList xs)
|
||||
|
||||
ofNumber :: T -> Either String Int
|
||||
ofNumber Leaf = Right 0
|
||||
ofNumber (Fork Leaf rest) = case ofNumber rest of
|
||||
toNumber :: T -> Either String Int
|
||||
toNumber Leaf = Right 0
|
||||
toNumber (Fork Leaf rest) = case toNumber rest of
|
||||
Right n -> Right (2 * n)
|
||||
Left err -> Left err
|
||||
ofNumber (Fork (Stem Leaf) rest) = case ofNumber rest of
|
||||
toNumber (Fork (Stem Leaf) rest) = case toNumber rest of
|
||||
Right n -> Right (1 + 2 * n)
|
||||
Left err -> Left err
|
||||
ofNumber _ = Left "Invalid Tree Calculus number"
|
||||
toNumber _ = Left "Invalid Tree Calculus number"
|
||||
|
||||
ofString :: T -> Either String String
|
||||
ofString tc = case ofList tc of
|
||||
Right list -> traverse (fmap toEnum . ofNumber) list
|
||||
toString :: T -> Either String String
|
||||
toString tc = case toList tc of
|
||||
Right list -> traverse (fmap toEnum . toNumber) list
|
||||
Left err -> Left "Invalid Tree Calculus string"
|
||||
|
||||
ofList :: T -> Either String [T]
|
||||
ofList Leaf = Right []
|
||||
ofList (Fork x rest) = case ofList rest of
|
||||
toList :: T -> Either String [T]
|
||||
toList Leaf = Right []
|
||||
toList (Fork x rest) = case toList rest of
|
||||
Right xs -> Right (x : xs)
|
||||
Left err -> Left err
|
||||
ofList _ = Left "Invalid Tree Calculus list"
|
||||
toList _ = Left "Invalid Tree Calculus list"
|
||||
|
||||
-- Utility
|
||||
toAscii :: T -> String
|
||||
|
@ -196,15 +196,15 @@ evaluationTests = testGroup "Evaluation Tests"
|
||||
, testCase "Evaluate string literal" $ do
|
||||
let input = "\"hello\""
|
||||
let ast = parseSingle input
|
||||
(result $ evalSingle Map.empty ast) @?= toString "hello"
|
||||
(result $ evalSingle Map.empty ast) @?= ofString "hello"
|
||||
, testCase "Evaluate list literal" $ do
|
||||
let input = "[t (t t)]"
|
||||
let ast = parseSingle input
|
||||
(result $ evalSingle Map.empty ast) @?= toList [Leaf, Stem Leaf]
|
||||
(result $ evalSingle Map.empty ast) @?= ofList [Leaf, Stem Leaf]
|
||||
, testCase "Evaluate empty list" $ do
|
||||
let input = "[]"
|
||||
let ast = parseSingle input
|
||||
(result $ evalSingle Map.empty ast) @?= toList []
|
||||
(result $ evalSingle Map.empty ast) @?= ofList []
|
||||
, testCase "Evaluate variable dependency chain" $ do
|
||||
let input = "x = t (t t)\n \
|
||||
\ y = x\n \
|
||||
|
Loading…
x
Reference in New Issue
Block a user