diff options
| author | Jan Tuomi <jans.tuomi@gmail.com> | 2022-01-31 11:08:30 +0200 |
|---|---|---|
| committer | Jan Tuomi <jans.tuomi@gmail.com> | 2022-01-31 11:27:29 +0200 |
| commit | 7390af67e18e6d17934541dd3c2d6d46cfad84d0 (patch) | |
| tree | 72231d88788752b443c4622041693327579f5fa0 /src/ltypes.hs | |
| parent | dd46dafe65e93b687ce5051288ab3f5cbfb7e09a (diff) | |
Pop words type-safely from stack
Diffstat (limited to 'src/ltypes.hs')
| -rw-r--r-- | src/ltypes.hs | 36 |
1 files changed, 36 insertions, 0 deletions
diff --git a/src/ltypes.hs b/src/ltypes.hs index ee4685e..e3f9b59 100644 --- a/src/ltypes.hs +++ b/src/ltypes.hs @@ -16,6 +16,42 @@ data LWord | LPhrase [LWord] deriving (Show, Eq) +data LWordT = LSymbolT | LIntegerT | LFloatT | LBoolT | LCharT | LLabelT | LPhraseT | AnyT deriving (Show) + +consumeErr wordT word = LException $ "expected " ++ show wordT ++ ", encountered " ++ show word + +consume1 :: LWordT -> [LWord] -> ExceptT LException IO (LWord, [LWord]) +consume1 wordT [] = + throwError $ LException $ "expected " ++ show wordT ++ ", encountered empty stack" +consume1 AnyT (word : stack') = pure (word, stack') +consume1 wordT@LSymbolT (word : stack') = + case word of LSymbol _ -> pure (word, stack'); _ -> throwError $ consumeErr wordT word +consume1 wordT@LIntegerT (word : stack') = + case word of LInteger _ -> pure (word, stack'); _ -> throwError $ consumeErr wordT word +consume1 wordT@LFloatT (word : stack') = + case word of LFloat _ -> pure (word, stack'); _ -> throwError $ consumeErr wordT word +consume1 wordT@LBoolT (word : stack') = + case word of LBool _ -> pure (word, stack'); _ -> throwError $ consumeErr wordT word +consume1 wordT@LCharT (word : stack') = + case word of LChar _ -> pure (word, stack'); _ -> throwError $ consumeErr wordT word +consume1 wordT@LLabelT (word : stack') = + case word of LLabel _ -> pure (word, stack'); _ -> throwError $ consumeErr wordT word +consume1 wordT@LPhraseT (word : stack') = + case word of LPhrase _ -> pure (word, stack'); _ -> throwError $ consumeErr wordT word + +consume2 :: LWordT -> LWordT -> [LWord] -> ExceptT LException IO (LWord, LWord, [LWord]) +consume2 wordT1 wordT2 stack = do + (ret1, stack1) <- consume1 wordT1 stack + (ret2, stack2) <- consume1 wordT2 stack1 + pure (ret1, ret2, stack2) + +consume3 :: LWordT -> LWordT -> LWordT -> [LWord] -> ExceptT LException IO (LWord, LWord, LWord, [LWord]) +consume3 wordT1 wordT2 wordT3 stack = do + (ret1, stack1) <- consume1 wordT1 stack + (ret2, stack2) <- consume1 wordT2 stack1 + (ret3, stack3) <- consume1 wordT3 stack2 + pure (ret1, ret2, ret3, stack3) + reprWord :: LWord -> String reprWord (LSymbol a) = a reprWord (LInteger a) = show a |