module DSLUnique

import StdEnv
import UniqueState

class list v
where
	list :: [Int] -> *v *[Int]
	(++.) infixr 5 :: *(v *[Int]) *(v *[Int]) -> *(v *[Int])

class select v
where
	(!.) infixl 9 :: *(v *[Int]) *(v Int) -> *(v Int)

class expr v
where
	lit :: a -> *(v a) | toStringU a
	(+.) infixl 6 :: *(v Int) *(v Int) -> *(v Int)
	(-.) infixl 6 :: *(v Int) *(v Int) -> *(v Int)
	(*.) infixl 7 :: *(v Int) *(v Int) -> *(v Int)
	(/.) infixl 7 :: *(v Int) *(v Int) -> *(v Int)
	If :: *(v Bool) *(v a) *(v a) -> *(v a)

class step v
where
	(>>*.) infixl 1 :: *(v .t) *[Step *v .t .u] -> *(v .u)

:: *Step v t u
	= IfValue ((v t) -> *(v Bool, v t)) ((v t) -> v u)
	| Always (v u)

class toStringU a
where
	toStringU :: .a -> String

instance toStringU Bool
where
	toStringU :: !.Bool -> String
	toStringU a
		= code inline {
			.d 0 1 i
				jsr BtoAC
			.o 1 0
		}
instance toStringU Int
where
	toStringU :: !.Int -> String
	toStringU a
		= code inline {
			.d 0 1 i
				jsr ItoAC
			.o 1 0
		}

instance toStringU String
where
	toStringU :: !.String -> String
	toStringU a
		= code inline {
			no_op
		}

show :: u:a -> *(State String u:b) | toStringU a
show x = State \s -> (undef, s +++ toStringU x)

instance list (State String)
where
	list x = show " list " >>| pure undef
	(++.) l r = l >>| show " ++ " >>| r >>| pure undef

instance select (State String)
where
	// >>| expects both sides to have the same attribute, this is not the case
	// here
	(!.) a i = a >>| show " ! " >>| i >>| pure undef

instance expr (State String)
where
	lit x = show x
	(+.) l r = l >>| show " + " >>| r >>| pure undef
	(-.) l r = l >>| show " - " >>| r >>| pure undef
	(*.) l r = l >>| show " * " >>| r >>| pure undef
	(/.) l r = l >>| show " / " >>| r >>| pure undef
	If b t e = show "If " >>| b >>| t >>| e >>| pure undef

instance step (State String)
where
	(>>*.) l cs = l >>| show " >>*. [" >>|
		printSteps cs
	where
		printSteps [] = show "]"
		printSteps [IfValue p c:cs]
			# (pb, pr) = p (show "i")
			= show "IfValue (\\i->(" >>| pb >>| show ", " >>| pr >>| show ")) (\\v->" >>| c (show "v") >>| show ")" >>| commaCont cs
		printSteps [Always c:cs] = show "Always " >>| c >>| commaCont cs

		commaCont [] = printSteps []
		commaCont cs = show ", " >>| printSteps cs
	
instance list Maybe
where
	list x = undef//Just x
	(++.) l r = l >>= \l -> r >>= \r -> pure (l ++ r)

instance select Maybe
where
	(!.) a i = a >>= \a -> i >>= \i -> pure (a!!i)

instance expr Maybe
where
	lit x = pure x
	(+.) l r = l >>= \l -> r >>= \r -> pure (l + r)
	(-.) l r = l >>= \l -> r >>= \r -> pure (l - r)
	(*.) l r = l >>= \l -> r >>= \r -> pure (l * r)
	(/.) _ (Just 0) = Nothing
	(/.) l r = l >>= \l -> r >>= \r -> pure (l / r)
	If b t e = b >>= \b
		| b = t
		| otherwise = e

instance step Maybe
where
	(>>*.) _ [] = Nothing
	(>>*.) _ [Always c:_] = c
	(>>*.) Nothing [_:cs] = Nothing >>*. cs
	(>>*.) v=:(Just _) [IfValue p c:cs]
		= case p v of
			(Nothing, v) = Nothing
			(Just b, v) = if b (c v) (v >>*. cs)

Start :: (Maybe Int, String, Maybe Int, String)
Start = (lit 1 +. lit 2, snd (runState (lit 1 +. lit 2) ""), t, snd (runState t ""))

t :: *(v Int) | expr, step v
t = lit 38 /. lit 0 >>*.
	[ IfValue (\v->(lit True, v)) (\i->i)
	, Always (lit 42)
	]