diff options
Diffstat (limited to 'DSL')
| -rw-r--r-- | DSL/Interpretation.hs | 1 | ||||
| -rw-r--r-- | DSL/Intrinsics.hs | 7 | ||||
| -rw-r--r-- | DSL/Parsing.hs | 1 | ||||
| -rw-r--r-- | DSL/Types.hs | 2 | ||||
| -rw-r--r-- | DSL/Util.hs | 4 |
5 files changed, 15 insertions, 0 deletions
diff --git a/DSL/Interpretation.hs b/DSL/Interpretation.hs index 02105f4..02f741d 100644 --- a/DSL/Interpretation.hs +++ b/DSL/Interpretation.hs @@ -40,6 +40,7 @@ applyIntrinsic i m = do I_AND -> and' I_OR -> or' I_XOR -> xor + I_STRCAT -> strcat I_EQUAL -> equal I_LESSTHAN -> lessThan I_GREATERTHAN -> greaterThan diff --git a/DSL/Intrinsics.hs b/DSL/Intrinsics.hs index 72bee4f..ecb0fad 100644 --- a/DSL/Intrinsics.hs +++ b/DSL/Intrinsics.hs @@ -91,6 +91,13 @@ or' = binBoolean "OR" $ \ x y -> [x || y] xor :: StackModifier xor = binBoolean "XOR" $ \ x y -> [x /= y] +strcat :: StackModifier +strcat = StackModifier { smName="STRCAT", smTypes=ts, smFunc=f } + where + ts = [tString, tString] + f (StackString x:StackString y:xs) = return $ StackString (x ++ y):xs + f _ = unreachable + equal :: StackModifier equal = StackModifier { smName="EQUAL", smTypes=ts, smFunc=f } where diff --git a/DSL/Parsing.hs b/DSL/Parsing.hs index ba6a5ee..fad68f1 100644 --- a/DSL/Parsing.hs +++ b/DSL/Parsing.hs @@ -74,6 +74,7 @@ intrinsicL = fromTableL [ (".", T_INTRINSIC I_DUMP) , ("&&", T_INTRINSIC I_AND) , ("||", T_INTRINSIC I_OR) , ("^", T_INTRINSIC I_XOR) + , ("++", T_INTRINSIC I_STRCAT) , ("==", T_INTRINSIC I_EQUAL) , ("<", T_INTRINSIC I_LESSTHAN) , (">", T_INTRINSIC I_GREATERTHAN) diff --git a/DSL/Types.hs b/DSL/Types.hs index 0a4de3f..7bd9f56 100644 --- a/DSL/Types.hs +++ b/DSL/Types.hs @@ -36,6 +36,8 @@ data Intrinsic | I_AND | I_OR | I_XOR + -- core string operations + | I_STRCAT -- core logical operations | I_EQUAL | I_LESSTHAN diff --git a/DSL/Util.hs b/DSL/Util.hs index 67435a2..7767b4b 100644 --- a/DSL/Util.hs +++ b/DSL/Util.hs @@ -13,6 +13,10 @@ tInt :: TypeCheck tInt (StackInt _) = True tInt _ = False +tString :: TypeCheck +tString (StackString _) = True +tString _ = False + runChecks :: [TypeCheck] -> Stack -> Maybe String runChecks fs s | length fs > length s = Just "stack underflow" |