Fakultas Ilmu Komputer UI

Skip to content
Snippets Groups Projects
Select Git revision
  • d89a49fb092df2413ccbf60b55cfb5b843b36f40
  • master default protected
  • v2.0.0
  • v1.1.1
  • v1.1.0
  • v1.0.0
6 results

Parser.hs

Blame
  • Code owners
    Assign users and groups as approvers for specific file changes. Learn more.
    Expression.hs 3.53 KiB
    {-# LANGUAGE FlexibleInstances #-}
    module Language.SystemF.Expression where
    
    import Language.Lambda.Util.PrettyPrint
    
    data SystemFExpr name ty
      = Var name                                        -- Variable
      | App (SystemFExpr name ty) (SystemFExpr name ty) -- Application
      | Abs name ty (SystemFExpr name ty)               -- Abstraction
      | TyAbs ty (SystemFExpr name ty)                  -- Type Abstraction
                                                        -- \X. body
    
      | TyApp (SystemFExpr name ty) ty                  -- Type Application
                                                        -- x [X]
      deriving (Eq, Show)
    
    -- Pretty printing
    instance (PrettyPrint n, PrettyPrint t) => PrettyPrint (SystemFExpr n t) where
      prettyPrint = prettyPrint . pprExpr empty
    
    -- Same as prettyPrint, but we assume the same type for names and types. Useful
    -- for testing.
    prettyPrint' :: PrettyPrint n => SystemFExpr n n -> String
    prettyPrint' = prettyPrint
    
    -- Pretty print a system f expression
    pprExpr :: (PrettyPrint n, PrettyPrint t) 
            => PDoc String 
            -> SystemFExpr n t 
            -> PDoc String
    pprExpr pdoc (Var n)        = prettyPrint n `add` pdoc
    pprExpr pdoc (App e1 e2)    = pprApp pdoc e1 e2
    pprExpr pdoc (Abs n t body) = pprAbs pdoc n t body
    pprExpr pdoc (TyAbs t body) = pprTAbs pdoc t body
    pprExpr pdoc (TyApp e ty)   = pprTApp pdoc e ty
    
    -- Pretty print an application
    pprApp :: (PrettyPrint n, PrettyPrint t)
           => PDoc String
           -> SystemFExpr n t
           -> SystemFExpr n t
           -> PDoc String
    pprApp pdoc e1@Abs{} e2@Abs{} = betweenParens (pprExpr pdoc e1) pdoc
      `mappend` addSpace (betweenParens (pprExpr pdoc e2) pdoc)
    pprApp pdoc e1 e2@App{} = pprExpr pdoc e1
      `mappend` addSpace (betweenParens (pprExpr pdoc e2) pdoc)
    pprApp pdoc e1 e2@Abs{} = pprExpr pdoc e1
      `mappend` addSpace (betweenParens (pprExpr pdoc e2) pdoc)
    pprApp pdoc e1@Abs{} e2 = betweenParens (pprExpr pdoc e1) pdoc
      `mappend` addSpace (pprExpr pdoc e2)
    pprApp pdoc e1 e2
      = pprExpr pdoc e1 `mappend` addSpace (pprExpr pdoc e2)
    
    pprTApp :: (PrettyPrint n, PrettyPrint t)
            => PDoc String
            -> SystemFExpr n t
            -> t
            -> PDoc String
    pprTApp pdoc expr ty = expr' `mappend` addSpace (between ty' "[" "]" empty)
      where expr' = pprExpr pdoc expr
            ty' = add (prettyPrint ty) empty
    
    -- Pretty print an abstraction
    pprAbs :: (PrettyPrint n, PrettyPrint t)
           => PDoc String
           -> n
           -> t
           -> SystemFExpr n t
           -> PDoc String
    pprAbs pdoc name ty body = between vars' lambda' ". " (pprExpr pdoc body')