diff options
| -rw-r--r-- | samples/interpolation.sample | 2 | ||||
| -rw-r--r-- | samples/testing.sample | 13 | ||||
| -rw-r--r-- | src/main.hs | 11 | ||||
| -rw-r--r-- | src/parser.hs | 36 | ||||
| -rw-r--r-- | src/utils.hs | 5 |
5 files changed, 50 insertions, 17 deletions
diff --git a/samples/interpolation.sample b/samples/interpolation.sample new file mode 100644 index 0000000..5a0d6eb --- /dev/null +++ b/samples/interpolation.sample @@ -0,0 +1,2 @@ +"Hello world!" s. +"What's up" "Jan" "%% %%!" s. diff --git a/samples/testing.sample b/samples/testing.sample index d57a7a7..f9352cd 100644 --- a/samples/testing.sample +++ b/samples/testing.sample @@ -11,7 +11,9 @@ define init-tests -- print ok, fail counter values define end-tests - '[ $ok-count @ reprup " ok, " up $fail-count @ reprup " failed" up '] p s. + $ok-count @ repr + $fail-count @ repr + "%% ok, %% failed" s. $ok-count forget $fail-count forget ; @@ -29,9 +31,14 @@ define assert-eq $actualp ! $actualp @ up $actualv ! $expected @ $actualv @ eq? - [ '[ $actualp @ reprup " == " up $expected @ reprup " 👍" up '] p s. + [ $actualp @ repr + $expected @ repr + "%% == %% 👍" s. $ok-count increment ] - [ '[ $actualp @ reprup " == " up $expected @ reprup " ❌" up ", actual: " up $actualv @ reprup '] p s. + [ $actualp @ repr + $expected @ repr + $actualv @ repr + "%% == %% ❌, actual: %%" s. $fail-count increment ] cond $expected forget $actualp forget $actualv forget diff --git a/src/main.hs b/src/main.hs index e14e5ac..c67cea0 100644 --- a/src/main.hs +++ b/src/main.hs @@ -34,7 +34,7 @@ data LState = LState lPhraseDepth :: Int, lDefs :: Map String [LWord], lSource :: [LWord], - lStrLitRefMap :: Map String String + lStrLitRefMap :: Map String [LWord] } deriving (Show) @@ -100,11 +100,10 @@ interpretWord state@LState {lStack = stack} word@(LBool _) = pure $ state {lStac interpretWord state@LState {lStack = stack} word@(LChar _) = pure $ state {lStack = word : stack} interpretWord state@LState {lStack = stack} word@(LLabel _) = pure $ state {lStack = word : stack} interpretWord state@LState {lStack = stack} word@(LPhrase _) = pure $ state {lStack = word : stack} -interpretWord state@LState {lStack = stack, lStrLitRefMap = strLitRefMap} (LStringLitRef ref) = - let strLit = strLitRefMap ! ref - chars = strLit $> map LChar - word = LPhrase chars - in pure $ state {lStack = word : stack} +-- string literals +interpretWord state@LState {lSource = source, lStrLitRefMap = strLitRefMap} (LStringLitRef ref) = + let strLitP = strLitRefMap ! ref + in pure $ state {lSource = strLitP ++ source} -- phrase markers are always evaled interpretWord state@LState {lStack = stack, lPhraseDepth = phraseDepth} word@(LSymbol "[") = pure $ state {lPhraseDepth = phraseDepth + 1, lStack = word : stack} diff --git a/src/parser.hs b/src/parser.hs index 79c30be..f6883da 100644 --- a/src/parser.hs +++ b/src/parser.hs @@ -2,7 +2,7 @@ module Parser where import qualified Data.Bifunctor as B import qualified Data.Hashable as DH -import Data.List (isPrefixOf) +import Data.List (intercalate, isInfixOf, isPrefixOf) import Data.Map (Map, (!)) import qualified Data.Map as M import qualified Data.Text as T @@ -21,26 +21,46 @@ removeComments source = let lines_ = lines source $> map (T.pack .> T.splitOn (T.pack "--") .> head .> T.unpack) in unlines lines_ -processStringLiterals source = - let refMap = M.empty - in processStringLiterals' Nothing refMap source +processStringLiterals = processStringLiterals' Nothing M.empty -processStringLiterals' :: Maybe String -> Map String String -> String -> (String, Map String String) +processStringLiterals' :: Maybe String -> Map String [LWord] -> String -> (String, Map String [LWord]) processStringLiterals' currentM refMap [] = case currentM of Just _ -> error "[error] nonterminated string literal" Nothing -> ([], refMap) processStringLiterals' currentM refMap (c : source) = case c of '"' -> case currentM of Just str -> + -- string literal ends let hash = DH.hash str $> show - newRefMap = M.insert hash str refMap + strP = str $> map LChar .> LPhrase + interpolated = processSLInterpolations strP + newRefMap = M.insert hash interpolated refMap (resSource, resRefMap) = processStringLiterals' Nothing newRefMap source in ("##" ++ hash ++ resSource, resRefMap) Nothing -> + -- string literal starts processStringLiterals' (Just "") refMap source other -> case currentM of - Just str -> processStringLiterals' (Just $ str ++ [c]) refMap source - Nothing -> processStringLiterals' Nothing refMap source $> B.first (c :) + Just str -> processStringLiterals' (Just $ str ++ [c]) refMap source -- add char to current string literal + Nothing -> processStringLiterals' Nothing refMap source $> B.first (c :) -- proceed normally + +processSLInterpolations :: LWord -> [LWord] +processSLInterpolations strP@(LPhrase lChars) + | "%%" `isInfixOf` chars = [LPhrase interpolated, LSymbol "unphrase"] + | otherwise = [strP] + where + chars = lChars $> map (\(LChar c) -> c) + tChars = T.pack chars + separatedByMarker = T.pack chars $> T.splitOn (T.pack "%%") .> map (T.unpack .> map LChar) + labelIndices = [0 .. length separatedByMarker - 1 - 1] + varStores = labelIndices $> map (\n -> [LLabel ("$__" ++ show n), LSymbol "!"]) .> reverse + part1 = concat varStores + symbolLookups = labelIndices $> map (\n -> [LLabel ("$__" ++ show n), LSymbol "@", LSymbol "unphrase"]) + part2 = LSymbol "'[" : concat (mix separatedByMarker symbolLookups) ++ [LSymbol "']", LSymbol "phrase"] + varForgets = labelIndices $> map (\n -> [LLabel ("$__" ++ show n), LSymbol "forget"]) + part3 = concat varForgets + interpolated = part1 ++ part2 ++ part3 +processSLInterpolations p = error $ "[error] non-phrase in processSLInterpolations: " ++ show p parseSource source = let woComments = source $> removeComments diff --git a/src/utils.hs b/src/utils.hs index beff25e..5b78682 100644 --- a/src/utils.hs +++ b/src/utils.hs @@ -38,3 +38,8 @@ isCharStr str = breakOn :: (a -> Bool) -> [a] -> ([a], [a]) breakOn cond xs = break cond xs $> B.second (drop 1) + +mix :: [a] -> [a] -> [a] +mix (x : xs) (y : ys) = x : y : mix xs ys +mix x [] = x +mix [] y = y
\ No newline at end of file |