A,B,C-stacks

1 files changed, 88 insertions, 0 deletions

diff --git a/BStack.icl b/BStack.icl
new file mode 100644
index 0000000..aa96551
--- /dev/null
+++ b/BStack.icl
@@ -0,0 +1,88 @@
+implementation module ABC.BStack
+
+import StdEnv
+
+import ABC.Def
+import ABC.Misc
+
+bs_copy   :: BSrc BStack -> BStack
+bs_copy i s = [bs_get i s:s]
+
+bs_get    :: BSrc BStack -> Basic
+bs_get _ []    = abortn "bs_get: index too large"
+bs_get 0 [b:s] = b
+bs_get i [_:s] = bs_get (i-1) s
+
+bs_getB   :: BSrc BStack -> Bool
+bs_getB i s = case bs_get i s of
+	(Bool b) = b
+	_        = abortn "bs_getB on non-Bool value\n"
+
+bs_getI   :: BSrc BStack -> Int
+bs_getI i s = case bs_get i s of
+	(Int i) = i
+	_       = abortn "bs_getI on non-Int value\n"
+
+bs_init   :: BStack
+bs_init = []
+
+bs_popn   :: NrArgs BStack -> BStack
+bs_popn 0 s     = s
+bs_popn _ []    = abortn "bs_popn: popping too many elements"
+bs_popn i [_:s] = bs_popn (i-1) s
+
+bs_push   :: Dynamic BStack -> BStack
+bs_push d s = [d:s]
+
+bs_pushB  :: Bool BStack -> BStack
+bs_pushB b s = [dynamic b:s]
+
+bs_pushI  :: Int BStack -> BStack
+bs_pushI i s = [dynamic i:s]
+
+bs_update :: BDst Dynamic BStack -> BStack
+bs_update 0 d [_:s] = [d:s]
+bs_update _ _ []    = abortn "bs_update: index too large"
+bs_update i d [e:s] = [e:bs_update (i-1) d s]
+
+bs_addI   :: BStack -> BStack
+bs_addI [Int m:Int n:s] = bs_pushI (m+n) s
+bs_addI _               = abortn "bs_addI: no integers"
+
+bs_decI   :: BStack -> BStack
+bs_decI [Int n:s] = bs_pushI (n-1) s
+bs_decI _         = abortn "bs_decI: no integer"
+
+bs_incI   :: BStack -> BStack
+bs_incI [Int n:s] = bs_pushI (n+1) s
+bs_incI _         = abortn "bs_incI: no integer"
+
+bs_eqB    :: BStack -> BStack
+bs_eqB [Bool b:Bool c:s] = bs_pushB (b == c) s
+bs_eqB _                 = abortn "bs_eqB: no booleans"
+
+bs_eqI    :: BStack -> BStack
+bs_eqI [Int m:Int n:s] = bs_pushB (m == n) s
+bs_eqI _               = abortn "bs_eqI: no integers"
+
+bs_eqBi   :: Bool BSrc BStack -> BStack
+bs_eqBi b i s = bs_pushB (bs_getB i s == b) s
+
+bs_eqIi   :: Int BSrc BStack -> BStack
+bs_eqIi n i s = bs_pushB (bs_getI i s == n) s
+
+bs_gtI    :: BStack -> BStack
+bs_gtI [Int m:Int n:s] = bs_pushB (m > n) s
+bs_gtI _               = abortn "bs_gtI: no integers"
+
+bs_ltI    :: BStack -> BStack
+bs_ltI [Int m:Int n:s] = bs_pushB (m < n) s
+bs_ltI _               = abortn "bs_ltI: no integers"
+
+bs_mulI   :: BStack -> BStack
+bs_mulI [Int m:Int n:s] = bs_pushB (m * n) s
+bs_mulI _               = abortn "bs_mulI: no integers"
+
+bs_subI   :: BStack -> BStack
+bs_subI [Int m:Int n:s] = bs_pushB (m - n) s
+bs_subI _               = abortn "bs_subI: no integers"