module SourcePrelude where

import Testbed
import HaskellPrims
import StdPrel

-----------------------------------------------------------------------------
-- Test Framework:

main :: IO ()
main  = test defnsHaskellPrims preludeDefns

savePrelude :: IO ()
savePrelude  = save "x.out" defnsHaskellPrims preludeDefns

-----------------------------------------------------------------------------
-- Main definitions:

preludeDefns :: [BindGroup]
preludeDefns
 = map toBg
   [
-- instance C [t] where op x = True
    [("op",Nothing, [([pNil], econst trueC)])], 

-- instance C [t] where op x = True
    [("op",Nothing, [([PCon trueC []], econst trueC)])], 

-- p y = (let f :: c -> Bool
--            f x = op (y >> return x)
--        in f, y ++ [])
    [("p",Nothing, 
      [([PVar "y"], ap [econst tup2C, 
                        elet [[("f", Just (Forall ([] :=> (TGen 0 `fn` tBool))), 
                                  [([PVar "x"], ap [evar "op", 
                                                  ap [econst thenM, evar "y", 
                                                     ap [econst returnM, (evar "x")]]])])]]
                              (evar "f"),  ap [evar "++", evar "y", eNil]])])],
-- q y = (y ++ [], 
--          let f :: c -> Bool
--            f x = op (y >> return x)
--        in f)
    [("q",Nothing, 
      [([PVar "y"], ap [econst tup2C, 
                        ap [evar "++", evar "y", eNil],
                        elet [[("f", Just (Forall ([] :=> (TGen 0 `fn` tBool))), 
                                  [([PVar "x"], ap [evar "op", 
                                                  ap [econst thenM, evar "y", 
                                                     ap [econst returnM, (evar "x")]]])])]]
                              (evar "f")])])],
    [("++",
      Just (Forall 
             ([] :=> 
              (TAp tList (TGen 0) `fn` TAp tList (TGen 0) `fn` TAp tList (TGen 0)))),
      [([pNil, PVar "ys"],
        evar "ys"),
       ([PCon consC [PVar "x", PVar "xs"], PVar "ys"],
        ap [econst consC, evar "x", ap [evar "++", evar "xs", evar "ys"]])])]
   ]