module Syntax.ASTConverter where
import qualified Syntax.TypesAMPL as T
import Language.LBNF.Compiletime
import Language.LBNF.Runtime
import MyParser.AMPLParserMeta


-- Haskell module generated by the BNF converter




myLLexer = resolveLayout True . myLexer


transIdent x = case x of
  Ident str  -> str 


transUIdent x = case x of
  UIdent str  -> str 


transAMPLCODE x = case x of
  Main handles cohandles constructors destructors processes functions start  -> T.AMPLcode 
                                                                                  (transHANDLES handles)
                                                                                  (transCOHANDLES cohandles)
                                                                                  (transCONSTRUCTORS constructors)
                                                                                  (transDESTRUCTORS destructors)
                                                                                  (transPROCESSES processes)
                                                                                  (transFUNCTIONS functions)
                                                                                  (transSTART start)


transHANDLE_SPEC x = case x of
  Hand_spec uident handles  -> T.Handle_spec(transUIdent uident) (map transHandle handles)

transHandle x = case x of
  HandName uident  -> (transUIdent uident)


transCONSTRUCTORS x = case x of
  Constructors structor_specs  -> map transSTRUCTOR_SPEC structor_specs
  Constructors_none  -> []


transDESTRUCTORS x = case x of
  Destructors structor_specs  -> map transSTRUCTOR_SPEC structor_specs
  Destructors_none  -> []


transSTRUCTOR_SPEC x = case x of
  Struct_spec uident structs  -> T.Struct_spec (transUIdent uident) (map transSTRUCT structs)


transSTRUCT x = case x of
  Struct uident n  -> (transUIdent uident , fromIntegral n)


transHANDLES x = case x of
  Handles handle_specs  -> map transHANDLE_SPEC handle_specs
  Handles_none          -> []


transCOHANDLES x = case x of
  Cohandles handle_specs  -> map transHANDLE_SPEC handle_specs
  Cohandles_none          -> []


transPROCESSES x = case x of
  Processes process_specs  -> map transPROCESS_SPEC   process_specs
  Processes_none  -> []


transPROCESS_SPEC x = case x of
  Process_spec uident varss ids1 ids2 coms3  -> T.Process_specf (transUIdent uident) (map transVars varss) ((map transIdent ids1),
                                                 (map transIdent ids2)) (transCOMS coms3)

transVars x = case x of
  VName id  -> (transIdent id)


transFUNCTIONS x = case x of
  Functions function_specs  -> map transFUNCTION_SPEC function_specs
  Functions_none  -> []


transFUNCTION_SPEC x = case x of
  Function_spec uident varss coms  -> T.Function_specf (transUIdent uident) (map transVars varss) (transCOMS coms)


transSTART x = case x of
  Start channel_spec coms  -> ((transCHANNEL_SPEC channel_spec),(transCOMS coms))


transCHANNEL_SPEC x = case x of
  Channel_specf ids1 ids2  -> T.Channel_specf (map transIdent ids1) (map transIdent ids2)
  Channel_spec cintegers1 cintegers2  -> T.Channel_spec (map transCInteger cintegers1) (map transCInteger cintegers1)


transCOMS x = case x of
  Prog coms  -> (map transCOM coms)


transCOM x = case x of
  AC_STORE  -> T.AC_STORE
  AC_STOREf id  -> T.AC_STOREf (transIdent id)
  AC_LOAD n  -> T.AC_LOAD (fromIntegral n) 
  AC_LOADf id  -> T.AC_LOADf (transIdent id)
  AC_RET   -> T.AC_RET
  AC_FRET  -> T.AC_FRET
  --AC_CALL id  -> T.AC_CALL $ transIdent x
  AC_CALLf id ids  -> T.AC_CALLf (transIdent id) (map transIdent ids)
  AC_INT cinteger  -> T.AC_INT $ transCInteger cinteger
  AC_LEQ  -> T.AC_LEQ
  AC_ADD  -> T.AC_ADD
  AC_MUL  -> T.AC_MUL
  AC_CONS n1 n2  -> T.AC_CONS (fromIntegral n1) (fromIntegral n2)
  AC_STRUCT uident1 uident2  -> T.AC_STRUCT ((transUIdent uident1) ,(transUIdent uident2)) []
  AC_STRUCTas uident1 uident2 idents -> T.AC_STRUCT ((transUIdent uident1) ,(transUIdent uident2)) (map transIdent idents)
  AC_CASE comss  -> T.AC_CASE (map transCOMS comss)
  AC_CASEf labelcomss  -> T.AC_CASEf (map transLABELCOMS labelcomss)
  AC_RECORD comss  -> T.AC_RECORD (map transCOMS comss)
  AC_RECORDf labelcomss  -> T.AC_RECORDf (map transLABELCOMS labelcomss)
  AC_DEST n1 n2  -> T.AC_DEST (fromIntegral n1) (fromIntegral n2)
  AC_GET cinteger  -> T.AC_GET (transCInteger cinteger)
  AC_GETf id  -> T.AC_GETf (transIdent id)
  AC_HPUT cinteger n  -> T.AC_HPUT (transCInteger cinteger) (fromIntegral n)
  AC_HPUTf id uident1 uident2  -> T.AC_HPUTf (transIdent id) (transUIdent uident1 , transUIdent uident2)
  AC_HCASE cinteger comss  ->  T.AC_HCASE (transCInteger cinteger) (map transCOMS comss)
  AC_HCASEf id labelcomss  -> T.AC_HCASEf (transIdent id) (map transLABELCOMS labelcomss)
  AC_PUT cinteger  -> T.AC_PUT (transCInteger cinteger)
  AC_PUTf id  -> T.AC_PUTf (transIdent id)
  AC_SPLIT cinteger1 cinteger2 cinteger3  -> T.AC_SPLIT (transCInteger cinteger1) ((transCInteger cinteger2),
                                                                                   (transCInteger cinteger3))
  AC_SPLITf id1 id2 id3  -> T.AC_SPLITf (transIdent id1) ((transIdent id2),(transIdent id3))
  AC_FORK cinteger1 cinteger2 cintegers3 coms4 cinteger5 cintegers6 coms7  -> 
                          let c1 = transCInteger cinteger1
                              c2 = ((transCInteger cinteger2),(map (transCInteger) cintegers3), (transCOMS coms4))
                              c3 = ((transCInteger cinteger5),(map (transCInteger) cintegers6), (transCOMS coms7)) 
                          in T.AC_FORK c1 (c2,c3)  
  AC_FORKf id1 id2 ids3 coms4 id5 ids6 coms7  -> T.AC_FORKf (transIdent id1) (c1,c2)
                                                    where c1 = (transIdent id2,(map transIdent ids3),transCOMS coms4)
                                                          c2 = (transIdent id5,(map transIdent ids6),transCOMS coms7)
  AC_PLUG ncintegers cintegers1 coms2 cintegers3 coms4  ->  T.AC_PLUG (map transNCInteger ncintegers)
                                                                      ((map transCInteger cintegers1),transCOMS coms2)
                                                                      ((map transCInteger cintegers3),transCOMS coms4)  
  AC_PLUGf nidents ids1 coms2 ids3 coms4  -> T.AC_PLUGf (map transNIdent nidents)
                                                        ((map transIdent ids1),(transCOMS coms2))
                                                        ((map transIdent ids3),(transCOMS coms4))
  AC_RUN trans uident  -> T.AC_RUN (map transTRAN trans) (transUIdent uident)                                
  AC_RUNf uident ids1 ids2 ids3  -> T.AC_RUNf (transUIdent uident)
                                              (map transIdent ids1)
                                              ((map transIdent ids1),(map transIdent ids1)) 
  AC_CLOSE cinteger  ->  T.AC_CLOSE (transCInteger cinteger)
  AC_CLOSEf id  -> T.AC_CLOSEf (transIdent id)
  AC_HALT cinteger  -> T.AC_HALT (transCInteger cinteger)
  AC_HALTf id  -> T.AC_HALTf (transIdent id)
  

transLABELCOMS x = case x of
  Labelcoms uident1 uident2 coms3  -> (((transUIdent uident1),(transUIdent uident1)),(transCOMS coms3))


transTRAN x = case x of
  TranIn1 n1 n2  -> ((fromIntegral n1),T.IN ,(fromIntegral n2))
  TranIn2 n1 n2  -> ((fromIntegral n1),T.OUT,(fromIntegral n2))


transNCInteger x = case x of
  Ncinteger cinteger  -> transCInteger cinteger


transNIdent x = case x of
  Nident id  -> transIdent id 


transCInteger x = case x of
  Positive n  -> (fromIntegral n)
  Negative n  -> (fromIntegral n)

someRandomFunc = do
   putStrLn "Enter a test file"
   progName  <- getLine
   prog      <- readFile progName
   let lexOutPut   =  myLLexer prog
       parOutPut   =  pAMPLCODE lexOutPut
   case parOutPut of
       Bad s     -> putStrLn $ "error in parsing" ++ s
       Ok  tree  ->do
        let  convOutPut  =  transAMPLCODE tree 
        putStrLn $ show convOutPut

{-

AMPLcode [Handle_spec "IntTerm" ["Get","Put","Close"]] [Handle_spec "Console" ["Get","Put","Close"]] [] [] [] [] 
(Channel_specf ["console"] ["intTerm1"],[AC_HPUTf "intTerm1" ("IntTerm","Get"),AC_GETf "intTerm1",AC_STOREf "x",
AC_HPUTf "intTerm1" ("IntTerm","Get"),AC_GETf "intTerm1",AC_STOREf "y",AC_LOADf "x",AC_LOADf "y",
AC_ADD,AC_HPUTf "intTerm1" ("IntTerm","Put"),AC_PUTf "intTerm1",AC_HPUTf "intTerm1" ("IntTerm","Close")
,AC_CLOSEf "intTerm1",AC_HPUTf "console" ("Console","Close"),AC_HALTf "console"])

-}
{-
Robin
AMPLcode [Handle_spec "IntTerm" ["Get","Put","Close"]] [Handle_spec "Console" ["Get","Put","Close"]] [] [] [] []
 (Channel_specf ["console"] ["intTerm1"],[AC_HPUTf "intTerm1" ("IntTerm","Get"),AC_GETf "intTerm1",AC_STOREf "x",
 AC_HPUTf "intTerm1" ("IntTerm","Get"),AC_GETf "intTerm1",AC_STOREf "y",AC_LOADf "x",AC_LOADf "y",AC_ADD,
 AC_HPUTf "intTerm1" ("IntTerm","Put"),AC_PUTf "intTerm1",AC_HPUTf "intTerm1" ("IntTerm","Close"),
 AC_CLOSEf "intTerm1",AC_HPUTf "console" ("Console","Close"),AC_HALTf "console"])
-}