James/tricu
1
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

REPL import warning; version info in CLI
All checks were successful
Test, Build, and Release / test (push) Successful in 1m18s
Details
Test, Build, and Release / build (push) Successful in 1m13s
Details

Browse Source 
Adds the ability to toggle result decoding in REPL. Adds several more
useful functions to the base library.
This commit is contained in:
James Eversole
2025-01-30 14:19:30 -06:00
parent bf1000d174
commit 7d1b6a741d
11 changed files with 142 additions and 61 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
src/Eval.hs
View File

@ -74,8 +74,6 @@ elimLambda = go
-- Composition optimization
go (SLambda [f] (SLambda [g] (SLambda [x] body)))
| body == SApp (SVar f) (SApp (SVar g) (SVar x)) = _B
go (SLambda [f] (SLambda [x] (SLambda [y] body)))
| body == SApp (SApp (SVar f) (SVar y)) (SVar x) = _C
-- General elimination
go (SLambda (v:vs) body)
| null vs = toSKI v (elimLambda body)
@ -97,7 +95,6 @@ elimLambda = go
_K = parseSingle "t t"
_I = parseSingle "t (t (t t)) t"
_B = parseSingle "t (t (t t (t (t (t t t)) t))) (t t)"
_C = parseSingle "t (t (t (t (t t (t (t (t t t)) t))) (t (t (t t (t t))) (t (t (t t t)) t)))) (t t (t t))"
_TRIAGE = parseSingle "t (t (t t (t (t (t t t))))) t"
isFree :: String -> TricuAST -> Bool

22
src/FileEval.hs
View File

@ -60,7 +60,8 @@ preprocessFile' inProgress filePath
Right asts -> do
let (imports, nonImports) = partition isImport asts
let newInProgress = Set.insert filePath inProgress
importedASTs <- concat <$> mapM (processImport newInProgress "") imports
importedASTs <- concat <$>
mapM (processImport newInProgress "") imports
pure $ importedASTs ++ nonImports
where
isImport :: TricuAST -> Bool
@ -116,13 +117,20 @@ nsBodyScoped moduleName args body = case body of
if name `elem` args
then SVar name
else nsBody moduleName (SVar name)
SApp func arg -> SApp (nsBodyScoped moduleName args func) (nsBodyScoped moduleName args arg)
SLambda innerArgs innerBody -> SLambda innerArgs (nsBodyScoped moduleName (args ++ innerArgs) innerBody)
SList items -> SList (map (nsBodyScoped moduleName args) items)
TFork left right -> TFork (nsBodyScoped moduleName args left) (nsBodyScoped moduleName args right)
TStem subtree -> TStem (nsBodyScoped moduleName args subtree)
SApp func arg ->
SApp (nsBodyScoped moduleName args func) (nsBodyScoped moduleName args arg)
SLambda innerArgs innerBody ->
SLambda innerArgs (nsBodyScoped moduleName (args ++ innerArgs) innerBody)
SList items ->
SList (map (nsBodyScoped moduleName args) items)
TFork left right ->
TFork (nsBodyScoped moduleName args left)
(nsBodyScoped moduleName args right)
TStem subtree ->
TStem (nsBodyScoped moduleName args subtree)
SDef name innerArgs innerBody ->
SDef (nsVariable moduleName name) innerArgs (nsBodyScoped moduleName (args ++ innerArgs) innerBody)
SDef (nsVariable moduleName name) innerArgs
(nsBodyScoped moduleName (args ++ innerArgs) innerBody)
other -> other
isPrefixed :: String -> Bool

6
src/Main.hs
View File

@ -8,7 +8,9 @@ import Research
import Control.Monad (foldM)
import Control.Monad.IO.Class (liftIO)
import Data.Version (showVersion)
import Text.Megaparsec (runParser)
import Paths_tricu (version)
import System.Console.CmdArgs
import qualified Data.Map as Map
@ -52,10 +54,12 @@ decodeMode = TDecode
main :: IO ()
main = do
let versionStr = "tricu Evaluator and REPL " ++ showVersion version
args <- cmdArgs $ modes [replMode, evaluateMode, decodeMode]
&= help "tricu: Exploring Tree Calculus"
&= program "tricu"
&= summary "tricu Evaluator and REPL"
&= summary versionStr
&= versionArg [explicit, name "version", summary versionStr]
case args of
Repl -> do
putStrLn "Welcome to the tricu REPL"

64
src/REPL.hs
View File

@ -6,55 +6,69 @@ import Lexer
import Parser
import Research
import Control.Exception (SomeException, catch)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Catch (handle, MonadCatch)
import Data.Char (isSpace)
import Data.List (dropWhile, dropWhileEnd, intercalate)
import Control.Exception (SomeException, catch)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Catch (handle, MonadCatch)
import Data.Char (isSpace)
import Data.List ( dropWhile
, dropWhileEnd
, intercalate
, isPrefixOf)
import System.Console.Haskeline
import qualified Data.Map as Map
repl :: Env -> IO ()
repl env = runInputT defaultSettings (withInterrupt (loop env))
repl env = runInputT defaultSettings (withInterrupt (loop env True))
where
loop :: Env -> InputT IO ()
loop env = handle (interruptHandler env) $ do
loop :: Env -> Bool -> InputT IO ()
loop env decode = handle (interruptHandler env decode) $ do
minput <- getInputLine "tricu < "
case minput of
Nothing -> outputStrLn "Exiting tricu"
Just s
| strip s == "" -> loop env decode
| strip s == "!exit" -> outputStrLn "Exiting tricu"
| strip s == "" -> loop env
| strip s == "!import" -> do
| strip s == "!decode" -> do
outputStrLn $ "Decoding " ++ (if decode then "disabled" else "enabled")
loop env (not decode)
| "!import" `isPrefixOf` strip s -> do
let afterImport = dropWhile (== ' ') $ drop (length ("!import" :: String)) (strip s)
if not (null afterImport)
then outputStrLn "Warning: REPL imports are interactive; \
\additional arguments are ignored."
else pure ()
path <- getInputLine "File path to load < "
case path of
Nothing -> do
outputStrLn "No input received; stopping import."
loop env
loop env decode
Just p -> do
loadedEnv <- liftIO $ evaluateFileWithContext env
loadedEnv <- liftIO $ evaluateFileWithContext env
(strip p) `catch` \e -> errorHandler env e
loop $ Map.delete "!result" (Map.union loadedEnv env)
| take 2 s == "--" -> loop env
loop (Map.delete "!result" (Map.union loadedEnv env)) decode
| take 2 s == "--" -> loop env decode
| otherwise -> do
newEnv <- liftIO $ processInput env s `catch` errorHandler env
loop newEnv
newEnv <- liftIO $ processInput env s decode `catch` errorHandler env
loop newEnv decode
interruptHandler :: Env -> Interrupt -> InputT IO ()
interruptHandler env _ = do
interruptHandler :: Env -> Bool -> Interrupt -> InputT IO ()
interruptHandler env decode _ = do
outputStrLn "Interrupted with CTRL+C\n\
\You can use the !exit command or CTRL+D to exit"
loop env
loop env decode
processInput :: Env -> String -> IO Env
processInput env input = do
processInput :: Env -> String -> Bool -> IO Env
processInput env input decode = do
let asts = parseTricu input
newEnv = evalTricu env asts
if
| Just r <- Map.lookup "!result" newEnv -> do
putStrLn $ "tricu > " ++ decodeResult r
| otherwise -> return ()
case Map.lookup "!result" newEnv of
Just r -> do
putStrLn $ "tricu > " ++
if decode
then decodeResult r
else show r
Nothing -> pure ()
return newEnv
errorHandler :: Env -> SomeException -> IO (Env)