1 files changed, 103 insertions, 0 deletions
diff --git a/ABC/Machine/BStack.icl b/ABC/Machine/BStack.icl
new file mode 100644
index 0000000..624692e
--- /dev/null
+++ b/ABC/Machine/BStack.icl
@@ -0,0 +1,103 @@
+implementation module ABC.Machine.BStack
+
+import StdEnv
+
+import ABC.Machine
+import ABC.Misc
+
+instance == Basic
+where
+	(==) (Bool b) (Bool c) = b == c
+	(==) (Int m)  (Int n)  = m == n
+	(==) _        _        = False
+
+instance toString Basic
+where
+	toString (Bool b) = toString b
+	toString (Int i)  = toString i
+
+:: BStack :== [Basic]
+
+instance toString BStack where toString xs = "[" <++ (",", xs) <+ "]"
+
+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   :: Basic BStack -> BStack
+bs_push d s = [d:s]
+
+bs_pushB  :: Bool BStack -> BStack
+bs_pushB b s = [Bool b:s]
+
+bs_pushI  :: Int BStack -> BStack
+bs_pushI i s = [Int i:s]
+
+bs_update :: BDst Basic 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_pushI (m * n) s
+bs_mulI _               = abortn "bs_mulI: no integers"
+
+bs_subI   :: BStack -> BStack
+bs_subI [Int m:Int n:s] = bs_pushI (m - n) s
+bs_subI _               = abortn "bs_subI: no integers"