diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Interpreter.hs | 4 | ||||
| -rw-r--r-- | src/LTypes.hs | 12 | ||||
| -rw-r--r-- | src/Parser.hs | 23 |
3 files changed, 33 insertions, 6 deletions
diff --git a/src/Interpreter.hs b/src/Interpreter.hs index cb71c62..7542fd4 100644 --- a/src/Interpreter.hs +++ b/src/Interpreter.hs @@ -7,6 +7,8 @@ import qualified Data.Map as M import LTypes import Utils +-- | Wait for unbuffered input (any key) from stdin. If 'q', return 'ExecExit', otherwise 'ExecContinue'. +-- If not in debug mode, immediately return 'ExecContinue' without waiting. debugWaitForChar Config {configDebugMode = mode} = do if mode then do @@ -16,11 +18,13 @@ debugWaitForChar Config {configDebugMode = mode} = do _ -> ExecContinue else pure ExecContinue +-- | If in debug mode, print the supplied message, automatically prefixed with "[debug]". Otherwise, no op. debugPrint Config {configDebugMode = mode} message = if mode then liftIO $ putStrLn $ fmt "[debug] %%" [message] else pure () +-- | interpretSource :: Config -> LState -> ExceptT LException IO LState interpretSource config state@LState {lSource = []} = pure state interpretSource config state@LState {lSource = (word : rest)} = do diff --git a/src/LTypes.hs b/src/LTypes.hs index 2d921da..c0fed4b 100644 --- a/src/LTypes.hs +++ b/src/LTypes.hs @@ -61,7 +61,7 @@ consume3 wordT1 wordT2 wordT3 stack = do (ret3, stack3) <- consume1 wordT3 stack2 pure (ret1, ret2, ret3, stack3) --- | Convert an 'LWord' to a string representation. +-- | Convert 'LWord' contents to a user-friendly string representation. reprWord :: LWord -> String reprWord (LSymbol a) = a reprWord (LInteger a) = show a @@ -75,8 +75,14 @@ reprWord (LPhrase a) = "P[ " ++ map reprWord a $> unwords ++ " ]" -- | Represents the interpreter state. The state changes one processed 'LWord' at a time. -- Contains: -- * 'lDict': A mapping from 'LLabel' string values to 'LWord'. Used for storing variables. --- * 'lStack': A list of 'LWord's, representing the global stack. The first element is the top of the stack. +-- * 'lStack': A list of 'LWord's, representing the global stack. The head is the top of the stack. +-- * 'lPhraseDepth': A number representing how many layers deep the current phrase context is. If zero (no phrase), +-- words are immediately evaluated when encountered. -- * 'lDefs': A mapping from 'LSymbol' string values to phrases of 'LWord's. Used for defining custom words. +-- * 'lSource': A list of words yet to be processed. The head will be processed first. +-- * 'lStrLitRefMap': A map from string (hash digest) to list of words. String literals in the source code +-- are replaced by a hash that is replaced with the refmap content upon evaluation. The refmap is populated +-- during parsing (literal desugaring). data LState = LState { lDict :: Map String LWord, lStack :: [LWord], @@ -87,6 +93,7 @@ data LState = LState } deriving (Show) +-- | Represents command line options and arguments, provided by the user. data Config = Config { configFileNameM :: Maybe String, configDebugMode :: Bool @@ -94,6 +101,7 @@ data Config = Config data ExecStep = ExecContinue | ExecExit +-- | If in debug mode, dump state to stdout. Otherwise, no op. debugState Config {configDebugMode = mode} state = if mode then do diff --git a/src/Parser.hs b/src/Parser.hs index 679f318..508be0f 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -10,6 +10,8 @@ import qualified Data.Text as T import LTypes import Utils +-- | Convert a string into an 'LWord'. +parseWord :: String -> LWord parseWord rawStr | isIntStr rawStr = LInteger (read rawStr) | isFloatStr rawStr = LFloat $ read rawStr @@ -18,9 +20,13 @@ parseWord rawStr | "$" `isPrefixOf` rawStr = LLabel $ tail rawStr | otherwise = LSymbol rawStr +-- | Remove line suffixes starting with the comment marker '--'. +removeComments :: String -> String removeComments = lines .> map (T.pack .> T.splitOn (T.pack "--") .> head .> T.unpack) .> unlines +-- | Preprocess the source by inserting "string literal references" in place of +-- string literals (e.g. "hello world") in order to remove significant whitespace from the source. processStringLiterals :: Maybe String -> Map String [LWord] -> String -> ExceptT LException IO (String, Map String [LWord]) processStringLiterals currentM refMap [] = case currentM of Just _ -> throwError $ LException "nonterminated string literal" @@ -46,8 +52,14 @@ processStringLiterals currentM refMap (c : source) = case c of -- proceed normally processStringLiterals Nothing refMap source $> fmap (B.first (c :)) -internalNVar n = LLabel $ fmt "$__%%" [show n] +-- | Format a new internal variable 'LLabel' for use in string literal desugaring. +produceInternalNVar :: Int -> LWord +produceInternalNVar n = LLabel $ fmt "$__%%" [show n] +-- | Desugar a "string phrase" (i.e. phrase containing only chars). +-- If the string contains the substring '%%', construct a sequence of words that consumes another string +-- phrase from the stack when evaluated, inserting that string where the '%%' substring was located. Can be used +-- with N instances of the '%%' substring (consumes N strings from stack). processSLInterpolations :: LWord -> ExceptT LException IO [LWord] processSLInterpolations strP@(LPhrase lChars) | "%%" `isInfixOf` chars = pure [LPhrase interpolated, LSymbol "unphrase"] @@ -58,18 +70,21 @@ processSLInterpolations strP@(LPhrase lChars) separatedByMarker = T.pack chars $> T.splitOn (T.pack "%%") .> map (T.unpack .> map LChar) labelIndices = [0 .. length separatedByMarker - 1 - 1] -- store n - 1 variables from stack - varStores = labelIndices $> map (\n -> [internalNVar n, LSymbol "!"]) .> reverse + varStores = labelIndices $> map (\n -> [produceInternalNVar n, LSymbol "!"]) .> reverse part1 = concat varStores -- interleave the n substrings and n - 1 variable reads - symbolLookups = labelIndices $> map (\n -> [internalNVar n, LSymbol "@", LSymbol "unphrase"]) + symbolLookups = labelIndices $> map (\n -> [produceInternalNVar n, LSymbol "@", LSymbol "unphrase"]) part2 = LSymbol "'[" : concat (mix separatedByMarker symbolLookups) ++ [LSymbol "']", LSymbol "phrase"] -- forget the temp variables used - varForgets = labelIndices $> map (\n -> [internalNVar n, LSymbol "forget"]) + varForgets = labelIndices $> map (\n -> [produceInternalNVar n, LSymbol "forget"]) part3 = concat varForgets -- combine everything into one phrase interpolated = part1 ++ part2 ++ part3 processSLInterpolations p = throwError $ LException $ fmt "non-phrase in processSLInterpolations: %%" [show p] +-- | Parse source code string to a list of 'LWord's and a string literal refmap (see 'LTypes.LState' for explanation). +-- Throws exception on parsing error. +parseSource :: String -> ExceptT LException IO ([LWord], Map String [LWord]) parseSource source = do let woComments = source $> removeComments (woStringLiterals, stringLiteralRefMap) <- processStringLiterals Nothing M.empty woComments |