Skip to content

Commit

Permalink
Removes redundant code and a few unnecessary dos
Browse files Browse the repository at this point in the history
  • Loading branch information
@pedrofurla
pedrofurla committed Sep 6, 2019
1 parent c55b213 commit 0e2ece0
Show file tree
Hide file tree
Showing 2 changed files with 53 additions and 51 deletions.
55 changes: 28 additions & 27 deletions app/Main.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -38,22 +38,22 @@ execAll (line:ls) env =
let exprs = lines content
env' <- execAll exprs env
execAll ls env'
Define v e -> do
let (res, env') = (evalDefine v e) `runState` env
Define v e ->
let (res, env') = (evalDefine v e) `runState` env in
case res of
Left err -> do
outputStrLn (show err)
execAll ls env'
Right f -> execAll ls env'
Show e -> do
let (res, env') = (evalExp e) `runState` env
Show e ->
let (res, env') = (evalExp e) `runState` env in
case res of
Left err -> do
outputStrLn (show err)
return env
Right exp -> do
--putStrLn ("----- original term : " ++ show exp)
showResult env exp 0
outputStrLn $ showResult env exp 0
execAll ls env'
Print s -> do
outputStrLn s
Expand All @@ -64,7 +64,7 @@ execute :: String -> Environment -> InputT IO Environment
execute line env =
case readLine line of
Left (SyntaxError e) -> do
outputStrLn $ show e
outputStrLn (show e)
return env
Right comm -> case comm of
Define v e -> do
Expand All @@ -77,7 +77,7 @@ execute line env =
let (res, env') = (evalExp e) `runState` env
case res of
Left err -> outputStrLn $ show err
Right exp -> showResult env exp 0
Right exp -> outputStrLn $ showResult env exp 0
return env
ShowDetailed e -> do
let (res, env') = (evalExp e) `runState` env
Expand All @@ -103,13 +103,14 @@ execute line env =
liftIO $ mapM_ (saveGlobal outFile) (reverse env)
liftIO $ hClose outFile
outputStrLn("--- successfully exported to import/" ++ f ++ ".plam")
else do
else
outputStrLn("--- export failed : " ++ f ++ " already exists")
return env
Review r -> do
case r of
"all" -> do
"all" ->
outputStrLn " ENVIRONMENT:"
>>
mapM_ showGlobal env
otherwise -> outputStrLn ("--- definition of " ++ show r ++ ": " ++ reviewVariable env r)
return env
Expand All @@ -128,32 +129,32 @@ execJustProg [] env = return env
execJustProg (line:ls) env =
case readLine line of
Left (SyntaxError err) -> do
putStrLn (show err)
putStrLn (show err)
return env
Right comm -> case comm of
Import f -> do
content <- liftIO $ readFile (importPath ++ f ++ ".plam")
let exprs = lines content
env' <- execJustProg exprs env
execJustProg ls env'
Define v e -> do
let (res, env') = (evalDefine v e) `runState` env
Define v e ->
let (res, env') = (evalDefine v e) `runState` env in
case res of
Left err -> do
putStrLn (show err)
execJustProg ls env'
Right f -> execJustProg ls env'
Show e -> do
let (res, env') = (evalExp e) `runState` env
Show e ->
let (res, env') = (evalExp e) `runState` env in
case res of
Left err -> do
putStrLn (show err)
return env
Right exp -> do
showProgResult env exp 0
putStrLn $ showProgResult env exp 0
execJustProg ls env'
ShowDetailed e -> do
let (res, env') = (evalExp e) `runState` env
ShowDetailed e ->
let (res, env') = (evalExp e) `runState` env in
case res of
Left err -> do
putStrLn (show err)
Expand Down Expand Up @@ -187,22 +188,22 @@ repl env = do
mline <- getInputLine "\x1b[1;36mpLam>\x1b[0m "
case mline of
Nothing -> return ()
Just ":quit" -> do
outputStrLn "\x1b[1;32mGoodbye!\x1b[0m"
return ()
Just ":q" -> do
outputStrLn "\x1b[1;32mGoodbye!\x1b[0m"
return ()
Just line -> do
env' <- execute line env
repl env'
Just line
| line == ":quit" || line == ":q"-> do
outputStrLn line
outputStrLn "\x1b[1;32mGoodbye!\x1b[0m"
return ()
| otherwise -> do
outputStrLn line
env' <- execute line env
repl env'

decideRun :: [String] -> IO()
decideRun args
| length args == 0 = do
putStrLn heading
runInputT defaultSettings (repl [])
| (length args == 1) && (head args == ":nohead") = do
| (length args == 1) && (head args == ":nohead") =
runInputT defaultSettings (repl [])
| (length args == 1) && (isplam (head args)) = do
content <- readFile (head args)
Expand Down
49 changes: 25 additions & 24 deletions src/Helper.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -139,41 +139,42 @@ goodCounter num rednum | rednum==0 = num
| otherwise = rednum

-------------------------------------------------------------------------------------
showResult :: Environment -> Expression -> Int -> InputT IO ()
showResult env exp num = do
showResult :: Environment -> Expression -> Int -> String
showResult env exp num =
let expnf = betaNF 0 exp
let count = goodCounter num (snd expnf)
outputStrLn ("\x1b[1;32m|> \x1b[0;33mreductions count : \x1b[1;31m" ++ show count)
outputStrLn ("\x1b[1;32m|> \x1b[0;33muncurried \x1b[1;33mβ-normal\x1b[0;33m form : \x1b[0m" ++ show (fst expnf))
outputStrLn ("\x1b[1;32m|> \x1b[0;33mcurried (partial) \x1b[1;33mα-equivalent\x1b[0;33m : \x1b[0m" ++ convertToNamesResult False False (Variable (LambdaVar '.' 0)) env (fst expnf))
count = goodCounter num (snd expnf)
in
showSummary env (fst expnf) count

showProgResult :: Environment -> Expression -> Int -> IO ()
showProgResult env exp num = do
showProgResult :: Environment -> Expression -> Int -> String
showProgResult env exp num =
let expnf = betaNF 0 exp
let count = goodCounter num (snd expnf)
putStrLn ("\x1b[1;32m|> \x1b[0;33mreductions count : \x1b[1;31m" ++ show count)
putStrLn ("\x1b[1;32m|> \x1b[0;33muncurried \x1b[1;33mβ-normal\x1b[0;33m form : \x1b[0m" ++ show (fst expnf))
putStrLn ("\x1b[1;32m|> \x1b[0;33mcurried (partial) \x1b[1;33mα-equivalent\x1b[0;33m : \x1b[0m" ++ convertToNamesResult False False (Variable (LambdaVar '.' 0)) env (fst expnf))

count = goodCounter num (snd expnf)
in
showSummary env (fst expnf) count

showSummary :: Environment -> Expression -> Int -> String
showSummary env exp count =
"\x1b[1;32m|> \x1b[0;33mreductions count : \x1b[1;31m" ++ show count ++ "\n" ++
"\x1b[1;32m|> \x1b[0;33muncurried \x1b[1;33mβ-normal\x1b[0;33m form : \x1b[0m" ++ show exp ++ "\n" ++
"\x1b[1;32m|> \x1b[0;33mcurried (partial) \x1b[1;33mα-equivalent\x1b[0;33m : \x1b[0m" ++ convertToNamesResult False False (Variable (LambdaVar '.' 0)) env exp


manualReduce :: Environment -> Expression -> Int -> InputT IO ()
manualReduce env exp num = do
outputStrLn ("\x1b[1;35m#" ++ show num ++ ":\x1b[0m" ++ (convertToNames False False (Variable (LambdaVar '.' 0)) env exp))
line <- getInputLine "\x1b[1;33mNext step?\x1b[0m [Y/n/f] (f: finish all remaining steps): "
case line of
Just "n" -> do
outputStrLn ("\x1b[1;32m|> \x1b[0;33mreductions count : \x1b[1;31m" ++ show num)
outputStrLn ("\x1b[1;32m|> \x1b[0;33muncurried \x1b[1;33mβ-normal\x1b[0;33m form : \x1b[0m" ++ show exp)
outputStrLn ("\x1b[1;32m|> \x1b[0;33mcurried (partial) \x1b[1;33mα-equivalent\x1b[0;33m : \x1b[0m" ++ convertToNames False False (Variable (LambdaVar '.' 0)) env exp)
Just "n" ->
outputStrLn $ showSummary env exp num
Just "f" -> autoReduce env exp num
otherwise -> do
otherwise ->
case (hasBetaRedex exp) of
True -> do
True ->
let e2b = betaReduction num exp
manualReduce env (fst e2b) (snd e2b)
False -> do
showResult env exp num
in manualReduce env (fst e2b) (snd e2b)
False ->
outputStrLn $ showResult env exp num


autoReduce :: Environment -> Expression -> Int -> InputT IO ()
Expand All @@ -184,7 +185,7 @@ autoReduce env exp num = do
let e2b = betaReduction num exp
autoReduce env (fst e2b) (snd e2b)
False -> do
showResult env exp num
outputStrLn $ showResult env exp num

autoProgReduce :: Environment -> Expression -> Int -> IO ()
autoProgReduce env exp num = do
Expand All @@ -194,6 +195,6 @@ autoProgReduce env exp num = do
let e2b = betaReduction num exp
autoProgReduce env (fst e2b) (snd e2b)
False -> do
showProgResult env exp num
putStrLn $ showProgResult env exp num

-------------------------------------------------------------------------------------

0 comments on commit 0e2ece0

Please sign in to comment.