data BalancedTernary = Bt [Int]

zeroTrim a = if null s then [0] else s where
	s = fst $ foldl f ([],[]) a
	f (x,y) 0 = (x, y++[0])
	f (x,y) z = (x++y++[z], [])

btList (Bt a) = a

instance Eq BalancedTernary where
	(==) a b = btList a == btList b

btNormalize = listBt . _carry 0 where
	_carry c [] = if c == 0 then [] else [c]
	_carry c (a:as) = r:_carry cc as where
		(cc, r) = f $ (a+c) `quotRem` 3 where
			f (x,  2) = (x + 1, -1)
			f (x, -2) = (x - 1,  1)
			f x = x

listBt = Bt . zeroTrim

instance Show BalancedTernary where
	show = reverse . map (\d->case d of -1->'-'; 0->'0'; 1->'+') . btList

strBt = Bt . zeroTrim.reverse.map (\c -> case c of '-' -> -1; '0' -> 0; '+' -> 1)

intBt :: Integral a => a -> BalancedTernary
intBt = fromIntegral . toInteger

btInt = foldr (\a z -> a + 3 * z) 0 . btList

listAdd a b = take (max (length a) (length b)) $ zipWith (+) (a++[0,0..]) (b++[0,0..])

-- mostly for operators, also small stuff to make GHC happy
instance Num BalancedTernary where
	negate = Bt . map negate . btList
	(+) x y = btNormalize $ listAdd (btList x) (btList y)
	(*) x y = btNormalize $ mul_ (btList x) (btList y) where
		mul_ _ [] = []
                mul_ as b = foldr (\a z -> listAdd (map (a*) b) (0:z)) [] as

	-- we don't need to define binary "-" by hand

	signum (Bt a) = if a == [0] then 0 else Bt [last a]
	abs x = if signum x == Bt [-1] then negate x else x

	fromInteger = btNormalize . f where
		f 0 = []
		f x = fromInteger (rem x 3) : f (quot x 3)


main = let	(a,b,c) = (strBt "+-0++0+", intBt (-436), strBt "+-++-")
		r = a * (b - c)
	in do
		print $ map btInt [a,b,c]
		print $ r
		print $ btInt r