summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJan Tuomi <jans.tuomi@gmail.com>2022-02-19 17:06:18 +0200
committerJan Tuomi <jans.tuomi@gmail.com>2022-02-19 17:06:18 +0200
commit2bd7673f23bf95a97323c632aeaff35df992c927 (patch)
tree0ca1b84695125b126fcf61f52898ad7789476035
parente8240a95aed965aa2ba82286283a47ef3afc59ca (diff)
Add more docsHEADmain
-rw-r--r--src/Interpreter.hs4
-rw-r--r--src/LTypes.hs12
-rw-r--r--src/Parser.hs23
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