{- Simple ADT for representing TML syntax. -}

module Term (Value(..)
            ,Term(..), Var(..), varType, varName 
            ,VarTree(..), varList, varTree, termList, termTree
            ,VarName ,LitRep, OpName
    
            ) where

import Control.Monad.Identity
import Type



-- Representation of target assembly language syntactic elements
-- eventually is done as Strings, so we might as well stop pretending
-- here..  We won't use it for much more than printing.
-- type VarName  = String  (from Compile.hs)

regPrefix = "r"
tmpVarName n = regPrefix ++ show n

type StructName = String
type VarName    = String
type LitRep     = String
type OpName     = String
type FunName    = String

type Order      = Int





-- Language syntax terms.  This syntax can be thought of as a
-- type-annotated Scheme syntax.

-- Note this syntax type is a superset of the language we're actually
-- interested in, i.e. it can represent nested expressions, higher
-- order functions, raw assignment, and certain Term combinations that
-- make no sense.

-- The subsets of interest can be enforced by a type class
-- representing a typed eDSL for which certain instances generate Term
-- datastructures.  Here the Haskell type system can be used to
-- prohibit certain combinations through the use of phantom types.
  
-- Note that Lambda has no return type.  The basic idea of the Term
-- language is to represent functions in a restricted form of CPS,
-- where only Op primitives are allowed in Let bindings, and App is
-- implemented as goto.

data Term   = Ref       Var                      -- variable reference
            | Let       Var Term Term            -- variable binding
            | LetRec    [(Var, Term)] Term       -- mutually recursive functions
            | Unpack    VarTree Term Term        -- destructure primitive datastructure
            | Lambda    VarTree Term             -- anonymous function
            | App       Term Term                -- function application.  
            | Lit       Type LitRep              -- literal
            | Op        Type OpName [Term]       -- primitive operation
            | Pack      Term                     -- create primitive datastructure
            | If        Term Term Term           -- conditional branching
            | Ret       Term                     -- invoke toplevel continuation
            | Get       Term Term                -- array reference
            | Set       Term Term Term           -- array assignment (statement)  
            | Begin     Term Term                -- statement sequencing
            | Void                               -- representation of ()
            | Topdef    Var Term                 -- toplevel definition
              
            | Atom      Term
            | Cons      Term Term
            | Nil
              
            | Car       Term
            | Cdr       Term
            | Unatom    Term  
            deriving (Eq,Show)
                     

-- Variables can refer to data values or functions.  In the latter
-- case type refers to the return value's type.
data Var    = Var Type VarName
            deriving (Eq, Show)
              
-- Defined separately: makes prettyprinting easier to read.                     
varType (Var t _) = t
varName (Var _ n) = n

-- Representation of a binary tree datastructure with individually
-- named members.
data VarTree = VarCons VarTree VarTree
             | VarAtom Var
             | VarNil  
             deriving (Eq,Show)

-- Obtain a VarTree from a Term tree of variable references.  Fail for
-- any other term.
varTree = vt where
  vt (Nil) = Just $ VarNil
  vt (Atom (Ref v)) = Just $ VarAtom v
  vt (Cons t1 t2) 
    | Just v1 <- vt t1
    , Just v2 <- vt t2 
    = Just $ VarCons v1 v2
  vt _ = Nothing

-- Flatten a variable tree to a list.
varList = vl where
  vl (VarNil) = []
  vl (VarAtom v) = [v]
  vl (VarCons v1 v2) = vl v1 ++ vl v2
  
-- Flatten a term tree into a list.
termList = tl where
  tl (Nil) = []
  tl (Atom t) = [t]
  tl (Cons t1 t2) = tl t1 ++ tl t2

-- Destructure a term based on a VarTree template, i.e. make it fit.
-- This makes sure that the VarTree types and term constructors are
-- matched in the following way:

--   VarAtom  <->  Atom 
--   VarCons  <->  Cons 
--   VarNil   <->  Nil

termTree template term = tt template term where
  tt VarNil _ = Nil
  
  tt (VarAtom _) t@(Atom _) = t -- OK
  tt (VarAtom _) t 
    = Atom (Unatom t)
  
  tt (VarCons vt1 vt2) t@(Cons t1 t2) =
    Cons (tt vt1 t1) (tt vt2 t2)
  
  tt (VarCons vt1 vt2) t =
    Cons (tt vt1 (Car t)) (tt vt2 (Cdr t))



-- While Term is used for compilation, Value is used for evaluation
-- together with the Identity monad.  
data Value t = Value t deriving (Eq, Show)
instance Show t => Show (Identity t) where
  show x = "Identity (" ++ (show $ runIdentity x) ++ ")"