content: {-# LANGUAGE ViewPatterns,DeriveFunctor,ScopedTypeVariables #-}
  -- | Translating from the Simple language to the First-Order language
  module HipSpec.Lang.SimpleToFO where
  
  import qualified HipSpec.Lang.Simple as S
  import HipSpec.Lang.Simple hiding (App)
  import HipSpec.Lang.FunctionalFO as FO
  
  import HipSpec.Id
  
  stfFun :: S.Function Id -> FO.Function Id
  stfFun (S.Function f (Forall tvs ty) as b) =
      FO.Function f tvs (zip as arg_tys) res_ty (stfBody b)
    where
      peel 0 t            = ([],t)
      peel n (ArrTy ta t) = let (tas,r) = peel (n - 1) t in (ta:tas,r)
      peel _ _            = error "SimpleToFO.peel: not an arrow type!"
  
      (arg_tys,res_ty)    = peel (length as) ty
  
  stfBody :: S.Body Id -> FO.Body Id
  stfBody b0 = case b0 of
      S.Case e alts -> FO.Case (stfExpr e) [ (stfPat p,stfBody b) | (p,b) <- alts ]
      S.Body e      -> FO.Body (stfExpr e)
  
  stfPat :: S.Pattern Id -> FO.Pattern Id
  stfPat p = case p of
      S.Default            -> FO.Default
      S.ConPat c _ty ts as -> FO.ConPat c ts as
      S.LitPat x           -> FO.LitPat x
  
  stfExpr :: S.Expr Id -> FO.Expr Id
  stfExpr e0 = case e0 of
      S.Lcl f _ty     -> Fun f [] []
      S.Gbl f _ty tys -> Ptr f tys
      S.Lit x         -> FO.Lit x
      S.App e1 e2 -> case S.exprType e1 of
          ArrTy t1 t2 -> App t1 t2 (stfExpr e1) (stfExpr e2)
          _           -> error "SimpleToFO.stfExpr: argument not an arrow type!"
  
  