forked from GitHub/gf-core
GF/src is now for 2.9, and the new sources are in src-3.0 - keep it this way until the release of GF 3
This commit is contained in:
aarne
485
src-3.0/Transfer/Syntax/Abs.hs
Normal file
485
src-3.0/Transfer/Syntax/Abs.hs
Normal file
@@ -0,0 +1,485 @@
|
||||
{-# OPTIONS_GHC -fglasgow-exts #-}
|
||||
module Transfer.Syntax.Abs (Tree(..), Module, Import, Decl, ConsDecl, Guard, Pattern, CommaPattern, FieldPattern, Exp, VarOrWild, LetDef, Case, Bind, FieldType, FieldValue, Ident, composOp, composOpM, composOpM_, composOpMPlus, composOpMonoid, composOpFold, compos, johnMajorEq) where
|
||||
|
||||
import Control.Monad (ap,MonadPlus,msum,mplus,mzero)
|
||||
import Control.Monad.Identity
|
||||
import Data.Monoid
|
||||
|
||||
-- Haskell module generated by the BNF converter
|
||||
|
||||
data Module_
|
||||
type Module = Tree Module_
|
||||
data Import_
|
||||
type Import = Tree Import_
|
||||
data Decl_
|
||||
type Decl = Tree Decl_
|
||||
data ConsDecl_
|
||||
type ConsDecl = Tree ConsDecl_
|
||||
data Guard_
|
||||
type Guard = Tree Guard_
|
||||
data Pattern_
|
||||
type Pattern = Tree Pattern_
|
||||
data CommaPattern_
|
||||
type CommaPattern = Tree CommaPattern_
|
||||
data FieldPattern_
|
||||
type FieldPattern = Tree FieldPattern_
|
||||
data Exp_
|
||||
type Exp = Tree Exp_
|
||||
data VarOrWild_
|
||||
type VarOrWild = Tree VarOrWild_
|
||||
data LetDef_
|
||||
type LetDef = Tree LetDef_
|
||||
data Case_
|
||||
type Case = Tree Case_
|
||||
data Bind_
|
||||
type Bind = Tree Bind_
|
||||
data FieldType_
|
||||
type FieldType = Tree FieldType_
|
||||
data FieldValue_
|
||||
type FieldValue = Tree FieldValue_
|
||||
data Ident_
|
||||
type Ident = Tree Ident_
|
||||
|
||||
data Tree :: * -> * where
|
||||
Module :: [Import] -> [Decl] -> Tree Module_
|
||||
Import :: Ident -> Tree Import_
|
||||
DataDecl :: Ident -> Exp -> [ConsDecl] -> Tree Decl_
|
||||
TypeDecl :: Ident -> Exp -> Tree Decl_
|
||||
ValueDecl :: Ident -> [Pattern] -> Guard -> Exp -> Tree Decl_
|
||||
DeriveDecl :: Ident -> Ident -> Tree Decl_
|
||||
ConsDecl :: Ident -> Exp -> Tree ConsDecl_
|
||||
GuardExp :: Exp -> Tree Guard_
|
||||
GuardNo :: Tree Guard_
|
||||
POr :: Pattern -> Pattern -> Tree Pattern_
|
||||
PListCons :: Pattern -> Pattern -> Tree Pattern_
|
||||
PConsTop :: Ident -> Pattern -> [Pattern] -> Tree Pattern_
|
||||
PCons :: Ident -> [Pattern] -> Tree Pattern_
|
||||
PRec :: [FieldPattern] -> Tree Pattern_
|
||||
PEmptyList :: Tree Pattern_
|
||||
PList :: [CommaPattern] -> Tree Pattern_
|
||||
PTuple :: CommaPattern -> [CommaPattern] -> Tree Pattern_
|
||||
PStr :: String -> Tree Pattern_
|
||||
PInt :: Integer -> Tree Pattern_
|
||||
PVar :: Ident -> Tree Pattern_
|
||||
PWild :: Tree Pattern_
|
||||
CommaPattern :: Pattern -> Tree CommaPattern_
|
||||
FieldPattern :: Ident -> Pattern -> Tree FieldPattern_
|
||||
EPi :: VarOrWild -> Exp -> Exp -> Tree Exp_
|
||||
EPiNoVar :: Exp -> Exp -> Tree Exp_
|
||||
EAbs :: VarOrWild -> Exp -> Tree Exp_
|
||||
ELet :: [LetDef] -> Exp -> Tree Exp_
|
||||
ECase :: Exp -> [Case] -> Tree Exp_
|
||||
EIf :: Exp -> Exp -> Exp -> Tree Exp_
|
||||
EDo :: [Bind] -> Exp -> Tree Exp_
|
||||
EBind :: Exp -> Exp -> Tree Exp_
|
||||
EBindC :: Exp -> Exp -> Tree Exp_
|
||||
EOr :: Exp -> Exp -> Tree Exp_
|
||||
EAnd :: Exp -> Exp -> Tree Exp_
|
||||
EEq :: Exp -> Exp -> Tree Exp_
|
||||
ENe :: Exp -> Exp -> Tree Exp_
|
||||
ELt :: Exp -> Exp -> Tree Exp_
|
||||
ELe :: Exp -> Exp -> Tree Exp_
|
||||
EGt :: Exp -> Exp -> Tree Exp_
|
||||
EGe :: Exp -> Exp -> Tree Exp_
|
||||
EListCons :: Exp -> Exp -> Tree Exp_
|
||||
EAdd :: Exp -> Exp -> Tree Exp_
|
||||
ESub :: Exp -> Exp -> Tree Exp_
|
||||
EMul :: Exp -> Exp -> Tree Exp_
|
||||
EDiv :: Exp -> Exp -> Tree Exp_
|
||||
EMod :: Exp -> Exp -> Tree Exp_
|
||||
ENeg :: Exp -> Tree Exp_
|
||||
EApp :: Exp -> Exp -> Tree Exp_
|
||||
EProj :: Exp -> Ident -> Tree Exp_
|
||||
ERecType :: [FieldType] -> Tree Exp_
|
||||
ERec :: [FieldValue] -> Tree Exp_
|
||||
EEmptyList :: Tree Exp_
|
||||
EList :: [Exp] -> Tree Exp_
|
||||
ETuple :: Exp -> [Exp] -> Tree Exp_
|
||||
EVar :: Ident -> Tree Exp_
|
||||
EType :: Tree Exp_
|
||||
EStr :: String -> Tree Exp_
|
||||
EInteger :: Integer -> Tree Exp_
|
||||
EDouble :: Double -> Tree Exp_
|
||||
EMeta :: Tree Exp_
|
||||
VVar :: Ident -> Tree VarOrWild_
|
||||
VWild :: Tree VarOrWild_
|
||||
LetDef :: Ident -> Exp -> Tree LetDef_
|
||||
Case :: Pattern -> Guard -> Exp -> Tree Case_
|
||||
BindVar :: VarOrWild -> Exp -> Tree Bind_
|
||||
BindNoVar :: Exp -> Tree Bind_
|
||||
FieldType :: Ident -> Exp -> Tree FieldType_
|
||||
FieldValue :: Ident -> Exp -> Tree FieldValue_
|
||||
Ident :: String -> Tree Ident_
|
||||
|
||||
composOp :: (forall a. Tree a -> Tree a) -> Tree c -> Tree c
|
||||
composOp f = runIdentity . composOpM (Identity . f)
|
||||
|
||||
composOpM :: Monad m => (forall a. Tree a -> m (Tree a)) -> Tree c -> m (Tree c)
|
||||
composOpM = compos return ap
|
||||
|
||||
composOpM_ :: Monad m => (forall a. Tree a -> m ()) -> Tree c -> m ()
|
||||
composOpM_ = composOpFold (return ()) (>>)
|
||||
|
||||
composOpMPlus :: MonadPlus m => (forall a. Tree a -> m b) -> Tree c -> m b
|
||||
composOpMPlus = composOpFold mzero mplus
|
||||
|
||||
composOpMonoid :: Monoid m => (forall a. Tree a -> m) -> Tree c -> m
|
||||
composOpMonoid = composOpFold mempty mappend
|
||||
|
||||
newtype C b a = C { unC :: b }
|
||||
composOpFold :: b -> (b -> b -> b) -> (forall a. Tree a -> b) -> Tree c -> b
|
||||
composOpFold z c f = unC . compos (\_ -> C z) (\(C x) (C y) -> C (c x y)) (C . f)
|
||||
|
||||
compos :: (forall a. a -> m a)
|
||||
-> (forall a b. m (a -> b) -> m a -> m b)
|
||||
-> (forall a. Tree a -> m (Tree a)) -> Tree c -> m (Tree c)
|
||||
compos r a f t = case t of
|
||||
Module imports decls -> r Module `a` foldr (a . a (r (:)) . f) (r []) imports `a` foldr (a . a (r (:)) . f) (r []) decls
|
||||
Import i -> r Import `a` f i
|
||||
DataDecl i exp consdecls -> r DataDecl `a` f i `a` f exp `a` foldr (a . a (r (:)) . f) (r []) consdecls
|
||||
TypeDecl i exp -> r TypeDecl `a` f i `a` f exp
|
||||
ValueDecl i patterns guard exp -> r ValueDecl `a` f i `a` foldr (a . a (r (:)) . f) (r []) patterns `a` f guard `a` f exp
|
||||
DeriveDecl i0 i1 -> r DeriveDecl `a` f i0 `a` f i1
|
||||
ConsDecl i exp -> r ConsDecl `a` f i `a` f exp
|
||||
GuardExp exp -> r GuardExp `a` f exp
|
||||
POr pattern0 pattern1 -> r POr `a` f pattern0 `a` f pattern1
|
||||
PListCons pattern0 pattern1 -> r PListCons `a` f pattern0 `a` f pattern1
|
||||
PConsTop i pattern patterns -> r PConsTop `a` f i `a` f pattern `a` foldr (a . a (r (:)) . f) (r []) patterns
|
||||
PCons i patterns -> r PCons `a` f i `a` foldr (a . a (r (:)) . f) (r []) patterns
|
||||
PRec fieldpatterns -> r PRec `a` foldr (a . a (r (:)) . f) (r []) fieldpatterns
|
||||
PList commapatterns -> r PList `a` foldr (a . a (r (:)) . f) (r []) commapatterns
|
||||
PTuple commapattern commapatterns -> r PTuple `a` f commapattern `a` foldr (a . a (r (:)) . f) (r []) commapatterns
|
||||
PVar i -> r PVar `a` f i
|
||||
CommaPattern pattern -> r CommaPattern `a` f pattern
|
||||
FieldPattern i pattern -> r FieldPattern `a` f i `a` f pattern
|
||||
EPi varorwild exp0 exp1 -> r EPi `a` f varorwild `a` f exp0 `a` f exp1
|
||||
EPiNoVar exp0 exp1 -> r EPiNoVar `a` f exp0 `a` f exp1
|
||||
EAbs varorwild exp -> r EAbs `a` f varorwild `a` f exp
|
||||
ELet letdefs exp -> r ELet `a` foldr (a . a (r (:)) . f) (r []) letdefs `a` f exp
|
||||
ECase exp cases -> r ECase `a` f exp `a` foldr (a . a (r (:)) . f) (r []) cases
|
||||
EIf exp0 exp1 exp2 -> r EIf `a` f exp0 `a` f exp1 `a` f exp2
|
||||
EDo binds exp -> r EDo `a` foldr (a . a (r (:)) . f) (r []) binds `a` f exp
|
||||
EBind exp0 exp1 -> r EBind `a` f exp0 `a` f exp1
|
||||
EBindC exp0 exp1 -> r EBindC `a` f exp0 `a` f exp1
|
||||
EOr exp0 exp1 -> r EOr `a` f exp0 `a` f exp1
|
||||
EAnd exp0 exp1 -> r EAnd `a` f exp0 `a` f exp1
|
||||
EEq exp0 exp1 -> r EEq `a` f exp0 `a` f exp1
|
||||
ENe exp0 exp1 -> r ENe `a` f exp0 `a` f exp1
|
||||
ELt exp0 exp1 -> r ELt `a` f exp0 `a` f exp1
|
||||
ELe exp0 exp1 -> r ELe `a` f exp0 `a` f exp1
|
||||
EGt exp0 exp1 -> r EGt `a` f exp0 `a` f exp1
|
||||
EGe exp0 exp1 -> r EGe `a` f exp0 `a` f exp1
|
||||
EListCons exp0 exp1 -> r EListCons `a` f exp0 `a` f exp1
|
||||
EAdd exp0 exp1 -> r EAdd `a` f exp0 `a` f exp1
|
||||
ESub exp0 exp1 -> r ESub `a` f exp0 `a` f exp1
|
||||
EMul exp0 exp1 -> r EMul `a` f exp0 `a` f exp1
|
||||
EDiv exp0 exp1 -> r EDiv `a` f exp0 `a` f exp1
|
||||
EMod exp0 exp1 -> r EMod `a` f exp0 `a` f exp1
|
||||
ENeg exp -> r ENeg `a` f exp
|
||||
EApp exp0 exp1 -> r EApp `a` f exp0 `a` f exp1
|
||||
EProj exp i -> r EProj `a` f exp `a` f i
|
||||
ERecType fieldtypes -> r ERecType `a` foldr (a . a (r (:)) . f) (r []) fieldtypes
|
||||
ERec fieldvalues -> r ERec `a` foldr (a . a (r (:)) . f) (r []) fieldvalues
|
||||
EList exps -> r EList `a` foldr (a . a (r (:)) . f) (r []) exps
|
||||
ETuple exp exps -> r ETuple `a` f exp `a` foldr (a . a (r (:)) . f) (r []) exps
|
||||
EVar i -> r EVar `a` f i
|
||||
VVar i -> r VVar `a` f i
|
||||
LetDef i exp -> r LetDef `a` f i `a` f exp
|
||||
Case pattern guard exp -> r Case `a` f pattern `a` f guard `a` f exp
|
||||
BindVar varorwild exp -> r BindVar `a` f varorwild `a` f exp
|
||||
BindNoVar exp -> r BindNoVar `a` f exp
|
||||
FieldType i exp -> r FieldType `a` f i `a` f exp
|
||||
FieldValue i exp -> r FieldValue `a` f i `a` f exp
|
||||
_ -> r t
|
||||
|
||||
instance Show (Tree c) where
|
||||
showsPrec n t = case t of
|
||||
Module imports decls -> opar n . showString "Module" . showChar ' ' . showsPrec 1 imports . showChar ' ' . showsPrec 1 decls . cpar n
|
||||
Import i -> opar n . showString "Import" . showChar ' ' . showsPrec 1 i . cpar n
|
||||
DataDecl i exp consdecls -> opar n . showString "DataDecl" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 exp . showChar ' ' . showsPrec 1 consdecls . cpar n
|
||||
TypeDecl i exp -> opar n . showString "TypeDecl" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 exp . cpar n
|
||||
ValueDecl i patterns guard exp -> opar n . showString "ValueDecl" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 patterns . showChar ' ' . showsPrec 1 guard . showChar ' ' . showsPrec 1 exp . cpar n
|
||||
DeriveDecl i0 i1 -> opar n . showString "DeriveDecl" . showChar ' ' . showsPrec 1 i0 . showChar ' ' . showsPrec 1 i1 . cpar n
|
||||
ConsDecl i exp -> opar n . showString "ConsDecl" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 exp . cpar n
|
||||
GuardExp exp -> opar n . showString "GuardExp" . showChar ' ' . showsPrec 1 exp . cpar n
|
||||
GuardNo -> showString "GuardNo"
|
||||
POr pattern0 pattern1 -> opar n . showString "POr" . showChar ' ' . showsPrec 1 pattern0 . showChar ' ' . showsPrec 1 pattern1 . cpar n
|
||||
PListCons pattern0 pattern1 -> opar n . showString "PListCons" . showChar ' ' . showsPrec 1 pattern0 . showChar ' ' . showsPrec 1 pattern1 . cpar n
|
||||
PConsTop i pattern patterns -> opar n . showString "PConsTop" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 pattern . showChar ' ' . showsPrec 1 patterns . cpar n
|
||||
PCons i patterns -> opar n . showString "PCons" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 patterns . cpar n
|
||||
PRec fieldpatterns -> opar n . showString "PRec" . showChar ' ' . showsPrec 1 fieldpatterns . cpar n
|
||||
PEmptyList -> showString "PEmptyList"
|
||||
PList commapatterns -> opar n . showString "PList" . showChar ' ' . showsPrec 1 commapatterns . cpar n
|
||||
PTuple commapattern commapatterns -> opar n . showString "PTuple" . showChar ' ' . showsPrec 1 commapattern . showChar ' ' . showsPrec 1 commapatterns . cpar n
|
||||
PStr str -> opar n . showString "PStr" . showChar ' ' . showsPrec 1 str . cpar n
|
||||
PInt n -> opar n . showString "PInt" . showChar ' ' . showsPrec 1 n . cpar n
|
||||
PVar i -> opar n . showString "PVar" . showChar ' ' . showsPrec 1 i . cpar n
|
||||
PWild -> showString "PWild"
|
||||
CommaPattern pattern -> opar n . showString "CommaPattern" . showChar ' ' . showsPrec 1 pattern . cpar n
|
||||
FieldPattern i pattern -> opar n . showString "FieldPattern" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 pattern . cpar n
|
||||
EPi varorwild exp0 exp1 -> opar n . showString "EPi" . showChar ' ' . showsPrec 1 varorwild . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
||||
EPiNoVar exp0 exp1 -> opar n . showString "EPiNoVar" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
||||
EAbs varorwild exp -> opar n . showString "EAbs" . showChar ' ' . showsPrec 1 varorwild . showChar ' ' . showsPrec 1 exp . cpar n
|
||||
ELet letdefs exp -> opar n . showString "ELet" . showChar ' ' . showsPrec 1 letdefs . showChar ' ' . showsPrec 1 exp . cpar n
|
||||
ECase exp cases -> opar n . showString "ECase" . showChar ' ' . showsPrec 1 exp . showChar ' ' . showsPrec 1 cases . cpar n
|
||||
EIf exp0 exp1 exp2 -> opar n . showString "EIf" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . showChar ' ' . showsPrec 1 exp2 . cpar n
|
||||
EDo binds exp -> opar n . showString "EDo" . showChar ' ' . showsPrec 1 binds . showChar ' ' . showsPrec 1 exp . cpar n
|
||||
EBind exp0 exp1 -> opar n . showString "EBind" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
||||
EBindC exp0 exp1 -> opar n . showString "EBindC" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
||||
EOr exp0 exp1 -> opar n . showString "EOr" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
||||
EAnd exp0 exp1 -> opar n . showString "EAnd" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
||||
EEq exp0 exp1 -> opar n . showString "EEq" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
||||
ENe exp0 exp1 -> opar n . showString "ENe" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
||||
ELt exp0 exp1 -> opar n . showString "ELt" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
||||
ELe exp0 exp1 -> opar n . showString "ELe" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
||||
EGt exp0 exp1 -> opar n . showString "EGt" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
||||
EGe exp0 exp1 -> opar n . showString "EGe" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
||||
EListCons exp0 exp1 -> opar n . showString "EListCons" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
||||
EAdd exp0 exp1 -> opar n . showString "EAdd" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
||||
ESub exp0 exp1 -> opar n . showString "ESub" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
||||
EMul exp0 exp1 -> opar n . showString "EMul" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
||||
EDiv exp0 exp1 -> opar n . showString "EDiv" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
||||
EMod exp0 exp1 -> opar n . showString "EMod" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
||||
ENeg exp -> opar n . showString "ENeg" . showChar ' ' . showsPrec 1 exp . cpar n
|
||||
EApp exp0 exp1 -> opar n . showString "EApp" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
||||
EProj exp i -> opar n . showString "EProj" . showChar ' ' . showsPrec 1 exp . showChar ' ' . showsPrec 1 i . cpar n
|
||||
ERecType fieldtypes -> opar n . showString "ERecType" . showChar ' ' . showsPrec 1 fieldtypes . cpar n
|
||||
ERec fieldvalues -> opar n . showString "ERec" . showChar ' ' . showsPrec 1 fieldvalues . cpar n
|
||||
EEmptyList -> showString "EEmptyList"
|
||||
EList exps -> opar n . showString "EList" . showChar ' ' . showsPrec 1 exps . cpar n
|
||||
ETuple exp exps -> opar n . showString "ETuple" . showChar ' ' . showsPrec 1 exp . showChar ' ' . showsPrec 1 exps . cpar n
|
||||
EVar i -> opar n . showString "EVar" . showChar ' ' . showsPrec 1 i . cpar n
|
||||
EType -> showString "EType"
|
||||
EStr str -> opar n . showString "EStr" . showChar ' ' . showsPrec 1 str . cpar n
|
||||
EInteger n -> opar n . showString "EInteger" . showChar ' ' . showsPrec 1 n . cpar n
|
||||
EDouble d -> opar n . showString "EDouble" . showChar ' ' . showsPrec 1 d . cpar n
|
||||
EMeta -> showString "EMeta"
|
||||
VVar i -> opar n . showString "VVar" . showChar ' ' . showsPrec 1 i . cpar n
|
||||
VWild -> showString "VWild"
|
||||
LetDef i exp -> opar n . showString "LetDef" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 exp . cpar n
|
||||
Case pattern guard exp -> opar n . showString "Case" . showChar ' ' . showsPrec 1 pattern . showChar ' ' . showsPrec 1 guard . showChar ' ' . showsPrec 1 exp . cpar n
|
||||
BindVar varorwild exp -> opar n . showString "BindVar" . showChar ' ' . showsPrec 1 varorwild . showChar ' ' . showsPrec 1 exp . cpar n
|
||||
BindNoVar exp -> opar n . showString "BindNoVar" . showChar ' ' . showsPrec 1 exp . cpar n
|
||||
FieldType i exp -> opar n . showString "FieldType" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 exp . cpar n
|
||||
FieldValue i exp -> opar n . showString "FieldValue" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 exp . cpar n
|
||||
Ident str -> opar n . showString "Ident" . showChar ' ' . showsPrec 1 str . cpar n
|
||||
where opar n = if n > 0 then showChar '(' else id
|
||||
cpar n = if n > 0 then showChar ')' else id
|
||||
|
||||
instance Eq (Tree c) where (==) = johnMajorEq
|
||||
|
||||
johnMajorEq :: Tree a -> Tree b -> Bool
|
||||
johnMajorEq (Module imports decls) (Module imports_ decls_) = imports == imports_ && decls == decls_
|
||||
johnMajorEq (Import i) (Import i_) = i == i_
|
||||
johnMajorEq (DataDecl i exp consdecls) (DataDecl i_ exp_ consdecls_) = i == i_ && exp == exp_ && consdecls == consdecls_
|
||||
johnMajorEq (TypeDecl i exp) (TypeDecl i_ exp_) = i == i_ && exp == exp_
|
||||
johnMajorEq (ValueDecl i patterns guard exp) (ValueDecl i_ patterns_ guard_ exp_) = i == i_ && patterns == patterns_ && guard == guard_ && exp == exp_
|
||||
johnMajorEq (DeriveDecl i0 i1) (DeriveDecl i0_ i1_) = i0 == i0_ && i1 == i1_
|
||||
johnMajorEq (ConsDecl i exp) (ConsDecl i_ exp_) = i == i_ && exp == exp_
|
||||
johnMajorEq (GuardExp exp) (GuardExp exp_) = exp == exp_
|
||||
johnMajorEq GuardNo GuardNo = True
|
||||
johnMajorEq (POr pattern0 pattern1) (POr pattern0_ pattern1_) = pattern0 == pattern0_ && pattern1 == pattern1_
|
||||
johnMajorEq (PListCons pattern0 pattern1) (PListCons pattern0_ pattern1_) = pattern0 == pattern0_ && pattern1 == pattern1_
|
||||
johnMajorEq (PConsTop i pattern patterns) (PConsTop i_ pattern_ patterns_) = i == i_ && pattern == pattern_ && patterns == patterns_
|
||||
johnMajorEq (PCons i patterns) (PCons i_ patterns_) = i == i_ && patterns == patterns_
|
||||
johnMajorEq (PRec fieldpatterns) (PRec fieldpatterns_) = fieldpatterns == fieldpatterns_
|
||||
johnMajorEq PEmptyList PEmptyList = True
|
||||
johnMajorEq (PList commapatterns) (PList commapatterns_) = commapatterns == commapatterns_
|
||||
johnMajorEq (PTuple commapattern commapatterns) (PTuple commapattern_ commapatterns_) = commapattern == commapattern_ && commapatterns == commapatterns_
|
||||
johnMajorEq (PStr str) (PStr str_) = str == str_
|
||||
johnMajorEq (PInt n) (PInt n_) = n == n_
|
||||
johnMajorEq (PVar i) (PVar i_) = i == i_
|
||||
johnMajorEq PWild PWild = True
|
||||
johnMajorEq (CommaPattern pattern) (CommaPattern pattern_) = pattern == pattern_
|
||||
johnMajorEq (FieldPattern i pattern) (FieldPattern i_ pattern_) = i == i_ && pattern == pattern_
|
||||
johnMajorEq (EPi varorwild exp0 exp1) (EPi varorwild_ exp0_ exp1_) = varorwild == varorwild_ && exp0 == exp0_ && exp1 == exp1_
|
||||
johnMajorEq (EPiNoVar exp0 exp1) (EPiNoVar exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
||||
johnMajorEq (EAbs varorwild exp) (EAbs varorwild_ exp_) = varorwild == varorwild_ && exp == exp_
|
||||
johnMajorEq (ELet letdefs exp) (ELet letdefs_ exp_) = letdefs == letdefs_ && exp == exp_
|
||||
johnMajorEq (ECase exp cases) (ECase exp_ cases_) = exp == exp_ && cases == cases_
|
||||
johnMajorEq (EIf exp0 exp1 exp2) (EIf exp0_ exp1_ exp2_) = exp0 == exp0_ && exp1 == exp1_ && exp2 == exp2_
|
||||
johnMajorEq (EDo binds exp) (EDo binds_ exp_) = binds == binds_ && exp == exp_
|
||||
johnMajorEq (EBind exp0 exp1) (EBind exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
||||
johnMajorEq (EBindC exp0 exp1) (EBindC exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
||||
johnMajorEq (EOr exp0 exp1) (EOr exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
||||
johnMajorEq (EAnd exp0 exp1) (EAnd exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
||||
johnMajorEq (EEq exp0 exp1) (EEq exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
||||
johnMajorEq (ENe exp0 exp1) (ENe exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
||||
johnMajorEq (ELt exp0 exp1) (ELt exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
||||
johnMajorEq (ELe exp0 exp1) (ELe exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
||||
johnMajorEq (EGt exp0 exp1) (EGt exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
||||
johnMajorEq (EGe exp0 exp1) (EGe exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
||||
johnMajorEq (EListCons exp0 exp1) (EListCons exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
||||
johnMajorEq (EAdd exp0 exp1) (EAdd exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
||||
johnMajorEq (ESub exp0 exp1) (ESub exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
||||
johnMajorEq (EMul exp0 exp1) (EMul exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
||||
johnMajorEq (EDiv exp0 exp1) (EDiv exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
||||
johnMajorEq (EMod exp0 exp1) (EMod exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
||||
johnMajorEq (ENeg exp) (ENeg exp_) = exp == exp_
|
||||
johnMajorEq (EApp exp0 exp1) (EApp exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
||||
johnMajorEq (EProj exp i) (EProj exp_ i_) = exp == exp_ && i == i_
|
||||
johnMajorEq (ERecType fieldtypes) (ERecType fieldtypes_) = fieldtypes == fieldtypes_
|
||||
johnMajorEq (ERec fieldvalues) (ERec fieldvalues_) = fieldvalues == fieldvalues_
|
||||
johnMajorEq EEmptyList EEmptyList = True
|
||||
johnMajorEq (EList exps) (EList exps_) = exps == exps_
|
||||
johnMajorEq (ETuple exp exps) (ETuple exp_ exps_) = exp == exp_ && exps == exps_
|
||||
johnMajorEq (EVar i) (EVar i_) = i == i_
|
||||
johnMajorEq EType EType = True
|
||||
johnMajorEq (EStr str) (EStr str_) = str == str_
|
||||
johnMajorEq (EInteger n) (EInteger n_) = n == n_
|
||||
johnMajorEq (EDouble d) (EDouble d_) = d == d_
|
||||
johnMajorEq EMeta EMeta = True
|
||||
johnMajorEq (VVar i) (VVar i_) = i == i_
|
||||
johnMajorEq VWild VWild = True
|
||||
johnMajorEq (LetDef i exp) (LetDef i_ exp_) = i == i_ && exp == exp_
|
||||
johnMajorEq (Case pattern guard exp) (Case pattern_ guard_ exp_) = pattern == pattern_ && guard == guard_ && exp == exp_
|
||||
johnMajorEq (BindVar varorwild exp) (BindVar varorwild_ exp_) = varorwild == varorwild_ && exp == exp_
|
||||
johnMajorEq (BindNoVar exp) (BindNoVar exp_) = exp == exp_
|
||||
johnMajorEq (FieldType i exp) (FieldType i_ exp_) = i == i_ && exp == exp_
|
||||
johnMajorEq (FieldValue i exp) (FieldValue i_ exp_) = i == i_ && exp == exp_
|
||||
johnMajorEq (Ident str) (Ident str_) = str == str_
|
||||
johnMajorEq _ _ = False
|
||||
|
||||
instance Ord (Tree c) where
|
||||
compare x y = compare (index x) (index y) `mappend` compareSame x y
|
||||
index :: Tree c -> Int
|
||||
index (Module _ _) = 0
|
||||
index (Import _) = 1
|
||||
index (DataDecl _ _ _) = 2
|
||||
index (TypeDecl _ _) = 3
|
||||
index (ValueDecl _ _ _ _) = 4
|
||||
index (DeriveDecl _ _) = 5
|
||||
index (ConsDecl _ _) = 6
|
||||
index (GuardExp _) = 7
|
||||
index (GuardNo ) = 8
|
||||
index (POr _ _) = 9
|
||||
index (PListCons _ _) = 10
|
||||
index (PConsTop _ _ _) = 11
|
||||
index (PCons _ _) = 12
|
||||
index (PRec _) = 13
|
||||
index (PEmptyList ) = 14
|
||||
index (PList _) = 15
|
||||
index (PTuple _ _) = 16
|
||||
index (PStr _) = 17
|
||||
index (PInt _) = 18
|
||||
index (PVar _) = 19
|
||||
index (PWild ) = 20
|
||||
index (CommaPattern _) = 21
|
||||
index (FieldPattern _ _) = 22
|
||||
index (EPi _ _ _) = 23
|
||||
index (EPiNoVar _ _) = 24
|
||||
index (EAbs _ _) = 25
|
||||
index (ELet _ _) = 26
|
||||
index (ECase _ _) = 27
|
||||
index (EIf _ _ _) = 28
|
||||
index (EDo _ _) = 29
|
||||
index (EBind _ _) = 30
|
||||
index (EBindC _ _) = 31
|
||||
index (EOr _ _) = 32
|
||||
index (EAnd _ _) = 33
|
||||
index (EEq _ _) = 34
|
||||
index (ENe _ _) = 35
|
||||
index (ELt _ _) = 36
|
||||
index (ELe _ _) = 37
|
||||
index (EGt _ _) = 38
|
||||
index (EGe _ _) = 39
|
||||
index (EListCons _ _) = 40
|
||||
index (EAdd _ _) = 41
|
||||
index (ESub _ _) = 42
|
||||
index (EMul _ _) = 43
|
||||
index (EDiv _ _) = 44
|
||||
index (EMod _ _) = 45
|
||||
index (ENeg _) = 46
|
||||
index (EApp _ _) = 47
|
||||
index (EProj _ _) = 48
|
||||
index (ERecType _) = 49
|
||||
index (ERec _) = 50
|
||||
index (EEmptyList ) = 51
|
||||
index (EList _) = 52
|
||||
index (ETuple _ _) = 53
|
||||
index (EVar _) = 54
|
||||
index (EType ) = 55
|
||||
index (EStr _) = 56
|
||||
index (EInteger _) = 57
|
||||
index (EDouble _) = 58
|
||||
index (EMeta ) = 59
|
||||
index (VVar _) = 60
|
||||
index (VWild ) = 61
|
||||
index (LetDef _ _) = 62
|
||||
index (Case _ _ _) = 63
|
||||
index (BindVar _ _) = 64
|
||||
index (BindNoVar _) = 65
|
||||
index (FieldType _ _) = 66
|
||||
index (FieldValue _ _) = 67
|
||||
index (Ident _) = 68
|
||||
compareSame :: Tree c -> Tree c -> Ordering
|
||||
compareSame (Module imports decls) (Module imports_ decls_) = mappend (compare imports imports_) (compare decls decls_)
|
||||
compareSame (Import i) (Import i_) = compare i i_
|
||||
compareSame (DataDecl i exp consdecls) (DataDecl i_ exp_ consdecls_) = mappend (compare i i_) (mappend (compare exp exp_) (compare consdecls consdecls_))
|
||||
compareSame (TypeDecl i exp) (TypeDecl i_ exp_) = mappend (compare i i_) (compare exp exp_)
|
||||
compareSame (ValueDecl i patterns guard exp) (ValueDecl i_ patterns_ guard_ exp_) = mappend (compare i i_) (mappend (compare patterns patterns_) (mappend (compare guard guard_) (compare exp exp_)))
|
||||
compareSame (DeriveDecl i0 i1) (DeriveDecl i0_ i1_) = mappend (compare i0 i0_) (compare i1 i1_)
|
||||
compareSame (ConsDecl i exp) (ConsDecl i_ exp_) = mappend (compare i i_) (compare exp exp_)
|
||||
compareSame (GuardExp exp) (GuardExp exp_) = compare exp exp_
|
||||
compareSame GuardNo GuardNo = EQ
|
||||
compareSame (POr pattern0 pattern1) (POr pattern0_ pattern1_) = mappend (compare pattern0 pattern0_) (compare pattern1 pattern1_)
|
||||
compareSame (PListCons pattern0 pattern1) (PListCons pattern0_ pattern1_) = mappend (compare pattern0 pattern0_) (compare pattern1 pattern1_)
|
||||
compareSame (PConsTop i pattern patterns) (PConsTop i_ pattern_ patterns_) = mappend (compare i i_) (mappend (compare pattern pattern_) (compare patterns patterns_))
|
||||
compareSame (PCons i patterns) (PCons i_ patterns_) = mappend (compare i i_) (compare patterns patterns_)
|
||||
compareSame (PRec fieldpatterns) (PRec fieldpatterns_) = compare fieldpatterns fieldpatterns_
|
||||
compareSame PEmptyList PEmptyList = EQ
|
||||
compareSame (PList commapatterns) (PList commapatterns_) = compare commapatterns commapatterns_
|
||||
compareSame (PTuple commapattern commapatterns) (PTuple commapattern_ commapatterns_) = mappend (compare commapattern commapattern_) (compare commapatterns commapatterns_)
|
||||
compareSame (PStr str) (PStr str_) = compare str str_
|
||||
compareSame (PInt n) (PInt n_) = compare n n_
|
||||
compareSame (PVar i) (PVar i_) = compare i i_
|
||||
compareSame PWild PWild = EQ
|
||||
compareSame (CommaPattern pattern) (CommaPattern pattern_) = compare pattern pattern_
|
||||
compareSame (FieldPattern i pattern) (FieldPattern i_ pattern_) = mappend (compare i i_) (compare pattern pattern_)
|
||||
compareSame (EPi varorwild exp0 exp1) (EPi varorwild_ exp0_ exp1_) = mappend (compare varorwild varorwild_) (mappend (compare exp0 exp0_) (compare exp1 exp1_))
|
||||
compareSame (EPiNoVar exp0 exp1) (EPiNoVar exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
||||
compareSame (EAbs varorwild exp) (EAbs varorwild_ exp_) = mappend (compare varorwild varorwild_) (compare exp exp_)
|
||||
compareSame (ELet letdefs exp) (ELet letdefs_ exp_) = mappend (compare letdefs letdefs_) (compare exp exp_)
|
||||
compareSame (ECase exp cases) (ECase exp_ cases_) = mappend (compare exp exp_) (compare cases cases_)
|
||||
compareSame (EIf exp0 exp1 exp2) (EIf exp0_ exp1_ exp2_) = mappend (compare exp0 exp0_) (mappend (compare exp1 exp1_) (compare exp2 exp2_))
|
||||
compareSame (EDo binds exp) (EDo binds_ exp_) = mappend (compare binds binds_) (compare exp exp_)
|
||||
compareSame (EBind exp0 exp1) (EBind exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
||||
compareSame (EBindC exp0 exp1) (EBindC exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
||||
compareSame (EOr exp0 exp1) (EOr exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
||||
compareSame (EAnd exp0 exp1) (EAnd exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
||||
compareSame (EEq exp0 exp1) (EEq exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
||||
compareSame (ENe exp0 exp1) (ENe exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
||||
compareSame (ELt exp0 exp1) (ELt exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
||||
compareSame (ELe exp0 exp1) (ELe exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
||||
compareSame (EGt exp0 exp1) (EGt exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
||||
compareSame (EGe exp0 exp1) (EGe exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
||||
compareSame (EListCons exp0 exp1) (EListCons exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
||||
compareSame (EAdd exp0 exp1) (EAdd exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
||||
compareSame (ESub exp0 exp1) (ESub exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
||||
compareSame (EMul exp0 exp1) (EMul exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
||||
compareSame (EDiv exp0 exp1) (EDiv exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
||||
compareSame (EMod exp0 exp1) (EMod exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
||||
compareSame (ENeg exp) (ENeg exp_) = compare exp exp_
|
||||
compareSame (EApp exp0 exp1) (EApp exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
||||
compareSame (EProj exp i) (EProj exp_ i_) = mappend (compare exp exp_) (compare i i_)
|
||||
compareSame (ERecType fieldtypes) (ERecType fieldtypes_) = compare fieldtypes fieldtypes_
|
||||
compareSame (ERec fieldvalues) (ERec fieldvalues_) = compare fieldvalues fieldvalues_
|
||||
compareSame EEmptyList EEmptyList = EQ
|
||||
compareSame (EList exps) (EList exps_) = compare exps exps_
|
||||
compareSame (ETuple exp exps) (ETuple exp_ exps_) = mappend (compare exp exp_) (compare exps exps_)
|
||||
compareSame (EVar i) (EVar i_) = compare i i_
|
||||
compareSame EType EType = EQ
|
||||
compareSame (EStr str) (EStr str_) = compare str str_
|
||||
compareSame (EInteger n) (EInteger n_) = compare n n_
|
||||
compareSame (EDouble d) (EDouble d_) = compare d d_
|
||||
compareSame EMeta EMeta = EQ
|
||||
compareSame (VVar i) (VVar i_) = compare i i_
|
||||
compareSame VWild VWild = EQ
|
||||
compareSame (LetDef i exp) (LetDef i_ exp_) = mappend (compare i i_) (compare exp exp_)
|
||||
compareSame (Case pattern guard exp) (Case pattern_ guard_ exp_) = mappend (compare pattern pattern_) (mappend (compare guard guard_) (compare exp exp_))
|
||||
compareSame (BindVar varorwild exp) (BindVar varorwild_ exp_) = mappend (compare varorwild varorwild_) (compare exp exp_)
|
||||
compareSame (BindNoVar exp) (BindNoVar exp_) = compare exp exp_
|
||||
compareSame (FieldType i exp) (FieldType i_ exp_) = mappend (compare i i_) (compare exp exp_)
|
||||
compareSame (FieldValue i exp) (FieldValue i_ exp_) = mappend (compare i i_) (compare exp exp_)
|
||||
compareSame (Ident str) (Ident str_) = compare str str_
|
||||
compareSame x y = error "BNFC error:" compareSame
|
||||
333
src-3.0/Transfer/Syntax/Doc.tex
Normal file
333
src-3.0/Transfer/Syntax/Doc.tex
Normal file
@@ -0,0 +1,333 @@
|
||||
\batchmode
|
||||
%This Latex file is machine-generated by the BNF-converter
|
||||
|
||||
\documentclass[a4paper,11pt]{article}
|
||||
\author{BNF-converter}
|
||||
\title{The Language Syntax}
|
||||
\setlength{\parindent}{0mm}
|
||||
\setlength{\parskip}{1mm}
|
||||
\begin{document}
|
||||
|
||||
\maketitle
|
||||
|
||||
\newcommand{\emptyP}{\mbox{$\epsilon$}}
|
||||
\newcommand{\terminal}[1]{\mbox{{\texttt {#1}}}}
|
||||
\newcommand{\nonterminal}[1]{\mbox{$\langle \mbox{{\sl #1 }} \! \rangle$}}
|
||||
\newcommand{\arrow}{\mbox{::=}}
|
||||
\newcommand{\delimit}{\mbox{$|$}}
|
||||
\newcommand{\reserved}[1]{\mbox{{\texttt {#1}}}}
|
||||
\newcommand{\literal}[1]{\mbox{{\texttt {#1}}}}
|
||||
\newcommand{\symb}[1]{\mbox{{\texttt {#1}}}}
|
||||
|
||||
This document was automatically generated by the {\em BNF-Converter}. It was generated together with the lexer, the parser, and the abstract syntax module, which guarantees that the document matches with the implementation of the language (provided no hand-hacking has taken place).
|
||||
|
||||
\section*{The lexical structure of Syntax}
|
||||
\subsection*{Identifiers}
|
||||
Identifiers \nonterminal{Ident} are unquoted strings beginning with a letter,
|
||||
followed by any combination of letters, digits, and the characters {\tt \_ '},
|
||||
reserved words excluded.
|
||||
|
||||
|
||||
\subsection*{Literals}
|
||||
String literals \nonterminal{String}\ have the form
|
||||
\terminal{"}$x$\terminal{"}, where $x$ is any sequence of any characters
|
||||
except \terminal{"}\ unless preceded by \verb6\6.
|
||||
|
||||
|
||||
Integer literals \nonterminal{Int}\ are nonempty sequences of digits.
|
||||
|
||||
|
||||
Double-precision float literals \nonterminal{Double}\ have the structure
|
||||
indicated by the regular expression $\nonterminal{digit}+ \mbox{{\it `.'}} \nonterminal{digit}+ (\mbox{{\it `e'}} \mbox{{\it `-'}}? \nonterminal{digit}+)?$ i.e.\
|
||||
two sequences of digits separated by a decimal point, optionally
|
||||
followed by an unsigned or negative exponent.
|
||||
|
||||
|
||||
|
||||
|
||||
\subsection*{Reserved words and symbols}
|
||||
The set of reserved words is the set of terminals appearing in the grammar. Those reserved words that consist of non-letter characters are called symbols, and they are treated in a different way from those that are similar to identifiers. The lexer follows rules familiar from languages like Haskell, C, and Java, including longest match and spacing conventions.
|
||||
|
||||
The reserved words used in Syntax are the following: \\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\reserved{Type}} &{\reserved{case}} &{\reserved{data}} \\
|
||||
{\reserved{derive}} &{\reserved{do}} &{\reserved{else}} \\
|
||||
{\reserved{if}} &{\reserved{import}} &{\reserved{in}} \\
|
||||
{\reserved{let}} &{\reserved{of}} &{\reserved{rec}} \\
|
||||
{\reserved{sig}} &{\reserved{then}} &{\reserved{where}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
The symbols used in Syntax are the following: \\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\symb{;}} &{\symb{:}} &{\symb{\{}} \\
|
||||
{\symb{\}}} &{\symb{{$=$}}} &{\symb{{$|$}}} \\
|
||||
{\symb{{$|$}{$|$}}} &{\symb{::}} &{\symb{(}} \\
|
||||
{\symb{)}} &{\symb{[}} &{\symb{]}} \\
|
||||
{\symb{,}} &{\symb{\_}} &{\symb{{$-$}{$>$}}} \\
|
||||
{\symb{$\backslash$}} &{\symb{{$<$}{$-$}}} &{\symb{{$>$}{$>$}{$=$}}} \\
|
||||
{\symb{{$>$}{$>$}}} &{\symb{\&\&}} &{\symb{{$=$}{$=$}}} \\
|
||||
{\symb{/{$=$}}} &{\symb{{$<$}}} &{\symb{{$<$}{$=$}}} \\
|
||||
{\symb{{$>$}}} &{\symb{{$>$}{$=$}}} &{\symb{{$+$}}} \\
|
||||
{\symb{{$-$}}} &{\symb{*}} &{\symb{/}} \\
|
||||
{\symb{\%}} &{\symb{.}} &{\symb{?}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\subsection*{Comments}
|
||||
Single-line comments begin with {\symb{{$-$}{$-$}}}. \\Multiple-line comments are enclosed with {\symb{\{{$-$}}} and {\symb{{$-$}\}}}.
|
||||
|
||||
\section*{The syntactic structure of Syntax}
|
||||
Non-terminals are enclosed between $\langle$ and $\rangle$.
|
||||
The symbols {\arrow} (production), {\delimit} (union)
|
||||
and {\emptyP} (empty rule) belong to the BNF notation.
|
||||
All other symbols are terminals.\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{Module}} & {\arrow} &{\nonterminal{ListImport}} {\nonterminal{ListDecl}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{Import}} & {\arrow} &{\terminal{import}} {\nonterminal{Ident}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{ListImport}} & {\arrow} &{\emptyP} \\
|
||||
& {\delimit} &{\nonterminal{Import}} {\terminal{;}} {\nonterminal{ListImport}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{Decl}} & {\arrow} &{\terminal{data}} {\nonterminal{Ident}} {\terminal{:}} {\nonterminal{Exp}} {\terminal{where}} {\terminal{\{}} {\nonterminal{ListConsDecl}} {\terminal{\}}} \\
|
||||
& {\delimit} &{\nonterminal{Ident}} {\terminal{:}} {\nonterminal{Exp}} \\
|
||||
& {\delimit} &{\nonterminal{Ident}} {\nonterminal{ListPattern}} {\nonterminal{Guard}} {\terminal{{$=$}}} {\nonterminal{Exp}} \\
|
||||
& {\delimit} &{\terminal{derive}} {\nonterminal{Ident}} {\nonterminal{Ident}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{ListDecl}} & {\arrow} &{\emptyP} \\
|
||||
& {\delimit} &{\nonterminal{Decl}} {\terminal{;}} {\nonterminal{ListDecl}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{ConsDecl}} & {\arrow} &{\nonterminal{Ident}} {\terminal{:}} {\nonterminal{Exp}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{ListConsDecl}} & {\arrow} &{\emptyP} \\
|
||||
& {\delimit} &{\nonterminal{ConsDecl}} \\
|
||||
& {\delimit} &{\nonterminal{ConsDecl}} {\terminal{;}} {\nonterminal{ListConsDecl}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{Guard}} & {\arrow} &{\terminal{{$|$}}} {\nonterminal{Exp1}} \\
|
||||
& {\delimit} &{\emptyP} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{Pattern}} & {\arrow} &{\nonterminal{Pattern1}} {\terminal{{$|$}{$|$}}} {\nonterminal{Pattern}} \\
|
||||
& {\delimit} &{\nonterminal{Pattern1}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{Pattern1}} & {\arrow} &{\nonterminal{Pattern2}} {\terminal{::}} {\nonterminal{Pattern1}} \\
|
||||
& {\delimit} &{\nonterminal{Pattern2}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{Pattern2}} & {\arrow} &{\nonterminal{Ident}} {\nonterminal{Pattern3}} {\nonterminal{ListPattern}} \\
|
||||
& {\delimit} &{\nonterminal{Pattern3}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{Pattern3}} & {\arrow} &{\terminal{rec}} {\terminal{\{}} {\nonterminal{ListFieldPattern}} {\terminal{\}}} \\
|
||||
& {\delimit} &{\terminal{[}} {\terminal{]}} \\
|
||||
& {\delimit} &{\terminal{[}} {\nonterminal{ListCommaPattern}} {\terminal{]}} \\
|
||||
& {\delimit} &{\terminal{(}} {\nonterminal{CommaPattern}} {\terminal{,}} {\nonterminal{ListCommaPattern}} {\terminal{)}} \\
|
||||
& {\delimit} &{\nonterminal{String}} \\
|
||||
& {\delimit} &{\nonterminal{Integer}} \\
|
||||
& {\delimit} &{\nonterminal{Ident}} \\
|
||||
& {\delimit} &{\terminal{\_}} \\
|
||||
& {\delimit} &{\terminal{(}} {\nonterminal{Pattern}} {\terminal{)}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{CommaPattern}} & {\arrow} &{\nonterminal{Pattern}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{ListCommaPattern}} & {\arrow} &{\nonterminal{CommaPattern}} \\
|
||||
& {\delimit} &{\nonterminal{CommaPattern}} {\terminal{,}} {\nonterminal{ListCommaPattern}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{ListPattern}} & {\arrow} &{\emptyP} \\
|
||||
& {\delimit} &{\nonterminal{Pattern3}} {\nonterminal{ListPattern}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{FieldPattern}} & {\arrow} &{\nonterminal{Ident}} {\terminal{{$=$}}} {\nonterminal{Pattern}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{ListFieldPattern}} & {\arrow} &{\emptyP} \\
|
||||
& {\delimit} &{\nonterminal{FieldPattern}} \\
|
||||
& {\delimit} &{\nonterminal{FieldPattern}} {\terminal{;}} {\nonterminal{ListFieldPattern}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{Exp}} & {\arrow} &{\terminal{(}} {\nonterminal{VarOrWild}} {\terminal{:}} {\nonterminal{Exp}} {\terminal{)}} {\terminal{{$-$}{$>$}}} {\nonterminal{Exp}} \\
|
||||
& {\delimit} &{\nonterminal{Exp1}} {\terminal{{$-$}{$>$}}} {\nonterminal{Exp}} \\
|
||||
& {\delimit} &{\nonterminal{Exp1}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{VarOrWild}} & {\arrow} &{\nonterminal{Ident}} \\
|
||||
& {\delimit} &{\terminal{\_}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{Exp1}} & {\arrow} &{\terminal{$\backslash$}} {\nonterminal{VarOrWild}} {\terminal{{$-$}{$>$}}} {\nonterminal{Exp1}} \\
|
||||
& {\delimit} &{\terminal{let}} {\terminal{\{}} {\nonterminal{ListLetDef}} {\terminal{\}}} {\terminal{in}} {\nonterminal{Exp1}} \\
|
||||
& {\delimit} &{\terminal{case}} {\nonterminal{Exp}} {\terminal{of}} {\terminal{\{}} {\nonterminal{ListCase}} {\terminal{\}}} \\
|
||||
& {\delimit} &{\terminal{if}} {\nonterminal{Exp}} {\terminal{then}} {\nonterminal{Exp}} {\terminal{else}} {\nonterminal{Exp1}} \\
|
||||
& {\delimit} &{\terminal{do}} {\terminal{\{}} {\nonterminal{ListBind}} {\nonterminal{Exp}} {\terminal{\}}} \\
|
||||
& {\delimit} &{\nonterminal{Exp2}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{LetDef}} & {\arrow} &{\nonterminal{Ident}} {\terminal{{$=$}}} {\nonterminal{Exp}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{ListLetDef}} & {\arrow} &{\emptyP} \\
|
||||
& {\delimit} &{\nonterminal{LetDef}} \\
|
||||
& {\delimit} &{\nonterminal{LetDef}} {\terminal{;}} {\nonterminal{ListLetDef}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{Case}} & {\arrow} &{\nonterminal{Pattern}} {\nonterminal{Guard}} {\terminal{{$-$}{$>$}}} {\nonterminal{Exp}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{ListCase}} & {\arrow} &{\emptyP} \\
|
||||
& {\delimit} &{\nonterminal{Case}} \\
|
||||
& {\delimit} &{\nonterminal{Case}} {\terminal{;}} {\nonterminal{ListCase}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{Bind}} & {\arrow} &{\nonterminal{VarOrWild}} {\terminal{{$<$}{$-$}}} {\nonterminal{Exp}} \\
|
||||
& {\delimit} &{\nonterminal{Exp}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{ListBind}} & {\arrow} &{\emptyP} \\
|
||||
& {\delimit} &{\nonterminal{Bind}} {\terminal{;}} {\nonterminal{ListBind}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{Exp3}} & {\arrow} &{\nonterminal{Exp3}} {\terminal{{$>$}{$>$}{$=$}}} {\nonterminal{Exp4}} \\
|
||||
& {\delimit} &{\nonterminal{Exp3}} {\terminal{{$>$}{$>$}}} {\nonterminal{Exp4}} \\
|
||||
& {\delimit} &{\nonterminal{Exp4}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{Exp4}} & {\arrow} &{\nonterminal{Exp5}} {\terminal{{$|$}{$|$}}} {\nonterminal{Exp4}} \\
|
||||
& {\delimit} &{\nonterminal{Exp5}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{Exp5}} & {\arrow} &{\nonterminal{Exp6}} {\terminal{\&\&}} {\nonterminal{Exp5}} \\
|
||||
& {\delimit} &{\nonterminal{Exp6}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{Exp6}} & {\arrow} &{\nonterminal{Exp7}} {\terminal{{$=$}{$=$}}} {\nonterminal{Exp7}} \\
|
||||
& {\delimit} &{\nonterminal{Exp7}} {\terminal{/{$=$}}} {\nonterminal{Exp7}} \\
|
||||
& {\delimit} &{\nonterminal{Exp7}} {\terminal{{$<$}}} {\nonterminal{Exp7}} \\
|
||||
& {\delimit} &{\nonterminal{Exp7}} {\terminal{{$<$}{$=$}}} {\nonterminal{Exp7}} \\
|
||||
& {\delimit} &{\nonterminal{Exp7}} {\terminal{{$>$}}} {\nonterminal{Exp7}} \\
|
||||
& {\delimit} &{\nonterminal{Exp7}} {\terminal{{$>$}{$=$}}} {\nonterminal{Exp7}} \\
|
||||
& {\delimit} &{\nonterminal{Exp7}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{Exp7}} & {\arrow} &{\nonterminal{Exp8}} {\terminal{::}} {\nonterminal{Exp7}} \\
|
||||
& {\delimit} &{\nonterminal{Exp8}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{Exp8}} & {\arrow} &{\nonterminal{Exp8}} {\terminal{{$+$}}} {\nonterminal{Exp9}} \\
|
||||
& {\delimit} &{\nonterminal{Exp8}} {\terminal{{$-$}}} {\nonterminal{Exp9}} \\
|
||||
& {\delimit} &{\nonterminal{Exp9}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{Exp9}} & {\arrow} &{\nonterminal{Exp9}} {\terminal{*}} {\nonterminal{Exp10}} \\
|
||||
& {\delimit} &{\nonterminal{Exp9}} {\terminal{/}} {\nonterminal{Exp10}} \\
|
||||
& {\delimit} &{\nonterminal{Exp9}} {\terminal{\%}} {\nonterminal{Exp10}} \\
|
||||
& {\delimit} &{\nonterminal{Exp10}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{Exp10}} & {\arrow} &{\terminal{{$-$}}} {\nonterminal{Exp10}} \\
|
||||
& {\delimit} &{\nonterminal{Exp11}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{Exp11}} & {\arrow} &{\nonterminal{Exp11}} {\nonterminal{Exp12}} \\
|
||||
& {\delimit} &{\nonterminal{Exp12}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{Exp12}} & {\arrow} &{\nonterminal{Exp12}} {\terminal{.}} {\nonterminal{Ident}} \\
|
||||
& {\delimit} &{\nonterminal{Exp13}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{Exp13}} & {\arrow} &{\terminal{sig}} {\terminal{\{}} {\nonterminal{ListFieldType}} {\terminal{\}}} \\
|
||||
& {\delimit} &{\terminal{rec}} {\terminal{\{}} {\nonterminal{ListFieldValue}} {\terminal{\}}} \\
|
||||
& {\delimit} &{\terminal{[}} {\terminal{]}} \\
|
||||
& {\delimit} &{\terminal{[}} {\nonterminal{ListExp}} {\terminal{]}} \\
|
||||
& {\delimit} &{\terminal{(}} {\nonterminal{Exp}} {\terminal{,}} {\nonterminal{ListExp}} {\terminal{)}} \\
|
||||
& {\delimit} &{\nonterminal{Ident}} \\
|
||||
& {\delimit} &{\terminal{Type}} \\
|
||||
& {\delimit} &{\nonterminal{String}} \\
|
||||
& {\delimit} &{\nonterminal{Integer}} \\
|
||||
& {\delimit} &{\nonterminal{Double}} \\
|
||||
& {\delimit} &{\terminal{?}} \\
|
||||
& {\delimit} &{\terminal{(}} {\nonterminal{Exp}} {\terminal{)}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{FieldType}} & {\arrow} &{\nonterminal{Ident}} {\terminal{:}} {\nonterminal{Exp}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{ListFieldType}} & {\arrow} &{\emptyP} \\
|
||||
& {\delimit} &{\nonterminal{FieldType}} \\
|
||||
& {\delimit} &{\nonterminal{FieldType}} {\terminal{;}} {\nonterminal{ListFieldType}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{FieldValue}} & {\arrow} &{\nonterminal{Ident}} {\terminal{{$=$}}} {\nonterminal{Exp}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{ListFieldValue}} & {\arrow} &{\emptyP} \\
|
||||
& {\delimit} &{\nonterminal{FieldValue}} \\
|
||||
& {\delimit} &{\nonterminal{FieldValue}} {\terminal{;}} {\nonterminal{ListFieldValue}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{Exp2}} & {\arrow} &{\nonterminal{Exp3}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
\begin{tabular}{lll}
|
||||
{\nonterminal{ListExp}} & {\arrow} &{\nonterminal{Exp}} \\
|
||||
& {\delimit} &{\nonterminal{Exp}} {\terminal{,}} {\nonterminal{ListExp}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
|
||||
|
||||
\end{document}
|
||||
|
||||
227
src-3.0/Transfer/Syntax/Layout.hs
Normal file
227
src-3.0/Transfer/Syntax/Layout.hs
Normal file
@@ -0,0 +1,227 @@
|
||||
module Transfer.Syntax.Layout where
|
||||
|
||||
import Transfer.Syntax.Lex
|
||||
|
||||
|
||||
import Data.Maybe (isNothing, fromJust)
|
||||
|
||||
-- Generated by the BNF Converter
|
||||
|
||||
-- local parameters
|
||||
|
||||
topLayout = True
|
||||
layoutWords = ["let","where","of","rec","sig","do"]
|
||||
layoutStopWords = ["in"]
|
||||
|
||||
-- layout separators
|
||||
|
||||
layoutOpen = "{"
|
||||
layoutClose = "}"
|
||||
layoutSep = ";"
|
||||
|
||||
-- | Replace layout syntax with explicit layout tokens.
|
||||
resolveLayout :: Bool -- ^ Whether to use top-level layout.
|
||||
-> [Token] -> [Token]
|
||||
resolveLayout tp = res Nothing [if tl then Implicit 1 else Explicit]
|
||||
where
|
||||
-- Do top-level layout if the function parameter and the grammar say so.
|
||||
tl = tp && topLayout
|
||||
|
||||
res :: Maybe Token -- ^ The previous token, if any.
|
||||
-> [Block] -- ^ A stack of layout blocks.
|
||||
-> [Token] -> [Token]
|
||||
|
||||
-- The stack should never be empty.
|
||||
res _ [] ts = error $ "Layout error: stack empty. Tokens: " ++ show ts
|
||||
|
||||
res _ st (t0:ts)
|
||||
-- We found an open brace in the input,
|
||||
-- put an explicit layout block on the stack.
|
||||
-- This is done even if there was no layout word,
|
||||
-- to keep opening and closing braces.
|
||||
| isLayoutOpen t0 = moveAlong (Explicit:st) [t0] ts
|
||||
|
||||
res _ st (t0:ts)
|
||||
-- Start a new layout block if the first token is a layout word
|
||||
| isLayout t0 =
|
||||
case ts of
|
||||
-- Explicit layout, just move on. The case above
|
||||
-- will push an explicit layout block.
|
||||
t1:_ | isLayoutOpen t1 -> moveAlong st [t0] ts
|
||||
-- at end of file, the start column doesn't matter
|
||||
_ -> let col = if null ts then column t0 else column (head ts)
|
||||
-- insert an open brace after the layout word
|
||||
b:ts' = addToken (nextPos t0) layoutOpen ts
|
||||
-- save the start column
|
||||
st' = Implicit col:st
|
||||
in moveAlong st' [t0,b] ts'
|
||||
|
||||
-- If we encounter a closing brace, exit the first explicit layout block.
|
||||
| isLayoutClose t0 =
|
||||
let st' = drop 1 (dropWhile isImplicit st)
|
||||
in if null st'
|
||||
then error $ "Layout error: Found " ++ layoutClose ++ " at ("
|
||||
++ show (line t0) ++ "," ++ show (column t0)
|
||||
++ ") without an explicit layout block."
|
||||
else moveAlong st' [t0] ts
|
||||
|
||||
-- We are in an implicit layout block
|
||||
res pt st@(Implicit n:ns) (t0:ts)
|
||||
|
||||
-- End of implicit block by a layout stop word
|
||||
| isStop t0 =
|
||||
-- Exit the current block and all implicit blocks
|
||||
-- more indented than the current token
|
||||
let (ebs,ns') = span (`moreIndent` column t0) ns
|
||||
moreIndent (Implicit x) y = x > y
|
||||
moreIndent Explicit _ = False
|
||||
-- the number of blocks exited
|
||||
b = 1 + length ebs
|
||||
bs = replicate b layoutClose
|
||||
-- Insert closing braces after the previous token.
|
||||
(ts1,ts2) = splitAt (1+b) $ addTokens (afterPrev pt) bs (t0:ts)
|
||||
in moveAlong ns' ts1 ts2
|
||||
|
||||
-- End of an implicit layout block
|
||||
| newLine && column t0 < n =
|
||||
-- Insert a closing brace after the previous token.
|
||||
let b:t0':ts' = addToken (afterPrev pt) layoutClose (t0:ts)
|
||||
-- Repeat, with the current block removed from the stack
|
||||
in moveAlong ns [b] (t0':ts')
|
||||
|
||||
-- Encounted a new line in an implicit layout block.
|
||||
| newLine && column t0 == n =
|
||||
-- Insert a semicolon after the previous token.
|
||||
-- unless we are the beginning of the file,
|
||||
-- or the previous token is a semicolon or open brace.
|
||||
if isNothing pt || isTokenIn [layoutSep,layoutOpen] (fromJust pt)
|
||||
then moveAlong st [t0] ts
|
||||
else let b:t0':ts' = addToken (afterPrev pt) layoutSep (t0:ts)
|
||||
in moveAlong st [b,t0'] ts'
|
||||
where newLine = case pt of
|
||||
Nothing -> True
|
||||
Just t -> line t /= line t0
|
||||
|
||||
-- Nothing to see here, move along.
|
||||
res _ st (t:ts) = moveAlong st [t] ts
|
||||
|
||||
-- At EOF: skip explicit blocks.
|
||||
res (Just t) (Explicit:bs) [] | null bs = []
|
||||
| otherwise = res (Just t) bs []
|
||||
|
||||
-- If we are using top-level layout, insert a semicolon after
|
||||
-- the last token, if there isn't one already
|
||||
res (Just t) [Implicit n] []
|
||||
| isTokenIn [layoutSep] t = []
|
||||
| otherwise = addToken (nextPos t) layoutSep []
|
||||
|
||||
-- At EOF in an implicit, non-top-level block: close the block
|
||||
res (Just t) (Implicit n:bs) [] =
|
||||
let c = addToken (nextPos t) layoutClose []
|
||||
in moveAlong bs c []
|
||||
|
||||
-- This should only happen if the input is empty.
|
||||
res Nothing st [] = []
|
||||
|
||||
-- | Move on to the next token.
|
||||
moveAlong :: [Block] -- ^ The layout stack.
|
||||
-> [Token] -- ^ Any tokens just processed.
|
||||
-> [Token] -- ^ the rest of the tokens.
|
||||
-> [Token]
|
||||
moveAlong st [] ts = error $ "Layout error: moveAlong got [] as old tokens"
|
||||
moveAlong st ot ts = ot ++ res (Just $ last ot) st ts
|
||||
|
||||
data Block = Implicit Int -- ^ An implicit layout block with its start column.
|
||||
| Explicit
|
||||
deriving Show
|
||||
|
||||
type Position = Posn
|
||||
|
||||
-- | Check if s block is implicit.
|
||||
isImplicit :: Block -> Bool
|
||||
isImplicit (Implicit _) = True
|
||||
isImplicit _ = False
|
||||
|
||||
-- | Insert a number of tokens at the begninning of a list of tokens.
|
||||
addTokens :: Position -- ^ Position of the first new token.
|
||||
-> [String] -- ^ Token symbols.
|
||||
-> [Token] -- ^ The rest of the tokens. These will have their
|
||||
-- positions updated to make room for the new tokens .
|
||||
-> [Token]
|
||||
addTokens p ss ts = foldr (addToken p) ts ss
|
||||
|
||||
-- | Insert a new symbol token at the begninning of a list of tokens.
|
||||
addToken :: Position -- ^ Position of the new token.
|
||||
-> String -- ^ Symbol in the new token.
|
||||
-> [Token] -- ^ The rest of the tokens. These will have their
|
||||
-- positions updated to make room for the new token.
|
||||
-> [Token]
|
||||
addToken p s ts = sToken p s : map (incrGlobal p (length s)) ts
|
||||
|
||||
-- | Get the position immediately to the right of the given token.
|
||||
-- If no token is given, gets the first position in the file.
|
||||
afterPrev :: Maybe Token -> Position
|
||||
afterPrev = maybe (Pn 0 1 1) nextPos
|
||||
|
||||
-- | Get the position immediately to the right of the given token.
|
||||
nextPos :: Token -> Position
|
||||
nextPos t = Pn (g + s) l (c + s + 1)
|
||||
where Pn g l c = position t
|
||||
s = tokenLength t
|
||||
|
||||
-- | Add to the global and column positions of a token.
|
||||
-- The column position is only changed if the token is on
|
||||
-- the same line as the given position.
|
||||
incrGlobal :: Position -- ^ If the token is on the same line
|
||||
-- as this position, update the column position.
|
||||
-> Int -- ^ Number of characters to add to the position.
|
||||
-> Token -> Token
|
||||
incrGlobal (Pn _ l0 _) i (PT (Pn g l c) t) =
|
||||
if l /= l0 then PT (Pn (g + i) l c) t
|
||||
else PT (Pn (g + i) l (c + i)) t
|
||||
incrGlobal _ _ p = error $ "cannot add token at " ++ show p
|
||||
|
||||
-- | Create a symbol token.
|
||||
sToken :: Position -> String -> Token
|
||||
sToken p s = PT p (TS s) -- reserved word or symbol
|
||||
|
||||
-- | Get the position of a token.
|
||||
position :: Token -> Position
|
||||
position t = case t of
|
||||
PT p _ -> p
|
||||
Err p -> p
|
||||
|
||||
-- | Get the line number of a token.
|
||||
line :: Token -> Int
|
||||
line t = case position t of Pn _ l _ -> l
|
||||
|
||||
-- | Get the column number of a token.
|
||||
column :: Token -> Int
|
||||
column t = case position t of Pn _ _ c -> c
|
||||
|
||||
-- | Check if a token is one of the given symbols.
|
||||
isTokenIn :: [String] -> Token -> Bool
|
||||
isTokenIn ts t = case t of
|
||||
PT _ (TS r) | elem r ts -> True
|
||||
_ -> False
|
||||
|
||||
-- | Check if a word is a layout start token.
|
||||
isLayout :: Token -> Bool
|
||||
isLayout = isTokenIn layoutWords
|
||||
|
||||
-- | Check if a token is a layout stop token.
|
||||
isStop :: Token -> Bool
|
||||
isStop = isTokenIn layoutStopWords
|
||||
|
||||
-- | Check if a token is the layout open token.
|
||||
isLayoutOpen :: Token -> Bool
|
||||
isLayoutOpen = isTokenIn [layoutOpen]
|
||||
|
||||
-- | Check if a token is the layout close token.
|
||||
isLayoutClose :: Token -> Bool
|
||||
isLayoutClose = isTokenIn [layoutClose]
|
||||
|
||||
-- | Get the number of characters in the token.
|
||||
tokenLength :: Token -> Int
|
||||
tokenLength t = length $ prToken t
|
||||
|
||||
337
src-3.0/Transfer/Syntax/Lex.hs
Normal file
337
src-3.0/Transfer/Syntax/Lex.hs
Normal file
File diff suppressed because one or more lines are too long
134
src-3.0/Transfer/Syntax/Lex.x
Normal file
134
src-3.0/Transfer/Syntax/Lex.x
Normal file
@@ -0,0 +1,134 @@
|
||||
-- -*- haskell -*-
|
||||
-- This Alex file was machine-generated by the BNF converter
|
||||
{
|
||||
{-# OPTIONS -fno-warn-incomplete-patterns #-}
|
||||
module Transfer.Syntax.Lex where
|
||||
|
||||
|
||||
}
|
||||
|
||||
|
||||
$l = [a-zA-Z\192 - \255] # [\215 \247] -- isolatin1 letter FIXME
|
||||
$c = [A-Z\192-\221] # [\215] -- capital isolatin1 letter FIXME
|
||||
$s = [a-z\222-\255] # [\247] -- small isolatin1 letter FIXME
|
||||
$d = [0-9] -- digit
|
||||
$i = [$l $d _ '] -- identifier character
|
||||
$u = [\0-\255] -- universal: any character
|
||||
|
||||
@rsyms = -- symbols and non-identifier-like reserved words
|
||||
\; | \: | \{ | \} | \= | \| | \| \| | \: \: | \( | \) | \[ | \] | \, | \_ | \- \> | \\ | \< \- | \> \> \= | \> \> | \& \& | \= \= | \/ \= | \< | \< \= | \> | \> \= | \+ | \- | \* | \/ | \% | \. | \?
|
||||
|
||||
:-
|
||||
"--" [.]* ; -- Toss single line comments
|
||||
"{-" ([$u # \-] | \- [$u # \}])* ("-")+ "}" ;
|
||||
|
||||
$white+ ;
|
||||
@rsyms { tok (\p s -> PT p (TS $ share s)) }
|
||||
|
||||
$l $i* { tok (\p s -> PT p (eitherResIdent (TV . share) s)) }
|
||||
\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \"{ tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) }
|
||||
|
||||
$d+ { tok (\p s -> PT p (TI $ share s)) }
|
||||
$d+ \. $d+ (e (\-)? $d+)? { tok (\p s -> PT p (TD $ share s)) }
|
||||
|
||||
{
|
||||
|
||||
tok f p s = f p s
|
||||
|
||||
share :: String -> String
|
||||
share = id
|
||||
|
||||
data Tok =
|
||||
TS !String -- reserved words and symbols
|
||||
| TL !String -- string literals
|
||||
| TI !String -- integer literals
|
||||
| TV !String -- identifiers
|
||||
| TD !String -- double precision float literals
|
||||
| TC !String -- character literals
|
||||
|
||||
deriving (Eq,Show,Ord)
|
||||
|
||||
data Token =
|
||||
PT Posn Tok
|
||||
| Err Posn
|
||||
deriving (Eq,Show,Ord)
|
||||
|
||||
tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l
|
||||
tokenPos (Err (Pn _ l _) :_) = "line " ++ show l
|
||||
tokenPos _ = "end of file"
|
||||
|
||||
posLineCol (Pn _ l c) = (l,c)
|
||||
mkPosToken t@(PT p _) = (posLineCol p, prToken t)
|
||||
|
||||
prToken t = case t of
|
||||
PT _ (TS s) -> s
|
||||
PT _ (TI s) -> s
|
||||
PT _ (TV s) -> s
|
||||
PT _ (TD s) -> s
|
||||
PT _ (TC s) -> s
|
||||
|
||||
_ -> show t
|
||||
|
||||
data BTree = N | B String Tok BTree BTree deriving (Show)
|
||||
|
||||
eitherResIdent :: (String -> Tok) -> String -> Tok
|
||||
eitherResIdent tv s = treeFind resWords
|
||||
where
|
||||
treeFind N = tv s
|
||||
treeFind (B a t left right) | s < a = treeFind left
|
||||
| s > a = treeFind right
|
||||
| s == a = t
|
||||
|
||||
resWords = b "import" (b "derive" (b "case" (b "Type" N N) (b "data" N N)) (b "else" (b "do" N N) (b "if" N N))) (b "rec" (b "let" (b "in" N N) (b "of" N N)) (b "then" (b "sig" N N) (b "where" N N)))
|
||||
where b s = B s (TS s)
|
||||
|
||||
unescapeInitTail :: String -> String
|
||||
unescapeInitTail = unesc . tail where
|
||||
unesc s = case s of
|
||||
'\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs
|
||||
'\\':'n':cs -> '\n' : unesc cs
|
||||
'\\':'t':cs -> '\t' : unesc cs
|
||||
'"':[] -> []
|
||||
c:cs -> c : unesc cs
|
||||
_ -> []
|
||||
|
||||
-------------------------------------------------------------------
|
||||
-- Alex wrapper code.
|
||||
-- A modified "posn" wrapper.
|
||||
-------------------------------------------------------------------
|
||||
|
||||
data Posn = Pn !Int !Int !Int
|
||||
deriving (Eq, Show,Ord)
|
||||
|
||||
alexStartPos :: Posn
|
||||
alexStartPos = Pn 0 1 1
|
||||
|
||||
alexMove :: Posn -> Char -> Posn
|
||||
alexMove (Pn a l c) '\t' = Pn (a+1) l (((c+7) `div` 8)*8+1)
|
||||
alexMove (Pn a l c) '\n' = Pn (a+1) (l+1) 1
|
||||
alexMove (Pn a l c) _ = Pn (a+1) l (c+1)
|
||||
|
||||
type AlexInput = (Posn, -- current position,
|
||||
Char, -- previous char
|
||||
String) -- current input string
|
||||
|
||||
tokens :: String -> [Token]
|
||||
tokens str = go (alexStartPos, '\n', str)
|
||||
where
|
||||
go :: (Posn, Char, String) -> [Token]
|
||||
go inp@(pos, _, str) =
|
||||
case alexScan inp 0 of
|
||||
AlexEOF -> []
|
||||
AlexError (pos, _, _) -> fail $ show pos ++ ": lexical error"
|
||||
AlexSkip inp' len -> go inp'
|
||||
AlexToken inp' len act -> act pos (take len str) : (go inp')
|
||||
|
||||
alexGetChar :: AlexInput -> Maybe (Char,AlexInput)
|
||||
alexGetChar (p, c, []) = Nothing
|
||||
alexGetChar (p, _, (c:s)) =
|
||||
let p' = alexMove p c
|
||||
in p' `seq` Just (c, (p', c, s))
|
||||
|
||||
alexInputPrevChar :: AlexInput -> Char
|
||||
alexInputPrevChar (p, c, s) = c
|
||||
}
|
||||
1822
src-3.0/Transfer/Syntax/Par.hs
Normal file
1822
src-3.0/Transfer/Syntax/Par.hs
Normal file
File diff suppressed because one or more lines are too long
340
src-3.0/Transfer/Syntax/Par.y
Normal file
340
src-3.0/Transfer/Syntax/Par.y
Normal file
@@ -0,0 +1,340 @@
|
||||
-- This Happy file was machine-generated by the BNF converter
|
||||
{
|
||||
{-# OPTIONS -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-}
|
||||
module Transfer.Syntax.Par where
|
||||
import Transfer.Syntax.Abs
|
||||
import Transfer.Syntax.Lex
|
||||
import Transfer.ErrM
|
||||
}
|
||||
|
||||
%name pModule Module
|
||||
%name pExp Exp
|
||||
|
||||
-- no lexer declaration
|
||||
%monad { Err } { thenM } { returnM }
|
||||
%tokentype { Token }
|
||||
|
||||
%token
|
||||
';' { PT _ (TS ";") }
|
||||
':' { PT _ (TS ":") }
|
||||
'{' { PT _ (TS "{") }
|
||||
'}' { PT _ (TS "}") }
|
||||
'=' { PT _ (TS "=") }
|
||||
'|' { PT _ (TS "|") }
|
||||
'||' { PT _ (TS "||") }
|
||||
'::' { PT _ (TS "::") }
|
||||
'(' { PT _ (TS "(") }
|
||||
')' { PT _ (TS ")") }
|
||||
'[' { PT _ (TS "[") }
|
||||
']' { PT _ (TS "]") }
|
||||
',' { PT _ (TS ",") }
|
||||
'_' { PT _ (TS "_") }
|
||||
'->' { PT _ (TS "->") }
|
||||
'\\' { PT _ (TS "\\") }
|
||||
'<-' { PT _ (TS "<-") }
|
||||
'>>=' { PT _ (TS ">>=") }
|
||||
'>>' { PT _ (TS ">>") }
|
||||
'&&' { PT _ (TS "&&") }
|
||||
'==' { PT _ (TS "==") }
|
||||
'/=' { PT _ (TS "/=") }
|
||||
'<' { PT _ (TS "<") }
|
||||
'<=' { PT _ (TS "<=") }
|
||||
'>' { PT _ (TS ">") }
|
||||
'>=' { PT _ (TS ">=") }
|
||||
'+' { PT _ (TS "+") }
|
||||
'-' { PT _ (TS "-") }
|
||||
'*' { PT _ (TS "*") }
|
||||
'/' { PT _ (TS "/") }
|
||||
'%' { PT _ (TS "%") }
|
||||
'.' { PT _ (TS ".") }
|
||||
'?' { PT _ (TS "?") }
|
||||
'Type' { PT _ (TS "Type") }
|
||||
'case' { PT _ (TS "case") }
|
||||
'data' { PT _ (TS "data") }
|
||||
'derive' { PT _ (TS "derive") }
|
||||
'do' { PT _ (TS "do") }
|
||||
'else' { PT _ (TS "else") }
|
||||
'if' { PT _ (TS "if") }
|
||||
'import' { PT _ (TS "import") }
|
||||
'in' { PT _ (TS "in") }
|
||||
'let' { PT _ (TS "let") }
|
||||
'of' { PT _ (TS "of") }
|
||||
'rec' { PT _ (TS "rec") }
|
||||
'sig' { PT _ (TS "sig") }
|
||||
'then' { PT _ (TS "then") }
|
||||
'where' { PT _ (TS "where") }
|
||||
|
||||
L_ident { PT _ (TV $$) }
|
||||
L_quoted { PT _ (TL $$) }
|
||||
L_integ { PT _ (TI $$) }
|
||||
L_doubl { PT _ (TD $$) }
|
||||
L_err { _ }
|
||||
|
||||
|
||||
%%
|
||||
|
||||
Ident :: { Ident } : L_ident { Ident $1 }
|
||||
String :: { String } : L_quoted { $1 }
|
||||
Integer :: { Integer } : L_integ { (read $1) :: Integer }
|
||||
Double :: { Double } : L_doubl { (read $1) :: Double }
|
||||
|
||||
Module :: { Module }
|
||||
Module : ListImport ListDecl { Module (reverse $1) (reverse $2) }
|
||||
|
||||
|
||||
Import :: { Import }
|
||||
Import : 'import' Ident { Import $2 }
|
||||
|
||||
|
||||
ListImport :: { [Import] }
|
||||
ListImport : {- empty -} { [] }
|
||||
| ListImport Import ';' { flip (:) $1 $2 }
|
||||
|
||||
|
||||
Decl :: { Decl }
|
||||
Decl : 'data' Ident ':' Exp 'where' '{' ListConsDecl '}' { DataDecl $2 $4 $7 }
|
||||
| Ident ':' Exp { TypeDecl $1 $3 }
|
||||
| Ident ListPattern Guard '=' Exp { ValueDecl $1 (reverse $2) $3 $5 }
|
||||
| 'derive' Ident Ident { DeriveDecl $2 $3 }
|
||||
|
||||
|
||||
ListDecl :: { [Decl] }
|
||||
ListDecl : {- empty -} { [] }
|
||||
| ListDecl Decl ';' { flip (:) $1 $2 }
|
||||
|
||||
|
||||
ConsDecl :: { ConsDecl }
|
||||
ConsDecl : Ident ':' Exp { ConsDecl $1 $3 }
|
||||
|
||||
|
||||
ListConsDecl :: { [ConsDecl] }
|
||||
ListConsDecl : {- empty -} { [] }
|
||||
| ConsDecl { (:[]) $1 }
|
||||
| ConsDecl ';' ListConsDecl { (:) $1 $3 }
|
||||
|
||||
|
||||
Guard :: { Guard }
|
||||
Guard : '|' Exp1 { GuardExp $2 }
|
||||
| {- empty -} { GuardNo }
|
||||
|
||||
|
||||
Pattern :: { Pattern }
|
||||
Pattern : Pattern1 '||' Pattern { POr $1 $3 }
|
||||
| Pattern1 { $1 }
|
||||
|
||||
|
||||
Pattern1 :: { Pattern }
|
||||
Pattern1 : Pattern2 '::' Pattern1 { PListCons $1 $3 }
|
||||
| Pattern2 { $1 }
|
||||
|
||||
|
||||
Pattern2 :: { Pattern }
|
||||
Pattern2 : Ident Pattern3 ListPattern { PConsTop $1 $2 (reverse $3) }
|
||||
| Pattern3 { $1 }
|
||||
|
||||
|
||||
Pattern3 :: { Pattern }
|
||||
Pattern3 : 'rec' '{' ListFieldPattern '}' { PRec $3 }
|
||||
| '[' ']' { PEmptyList }
|
||||
| '[' ListCommaPattern ']' { PList $2 }
|
||||
| '(' CommaPattern ',' ListCommaPattern ')' { PTuple $2 $4 }
|
||||
| String { PStr $1 }
|
||||
| Integer { PInt $1 }
|
||||
| Ident { PVar $1 }
|
||||
| '_' { PWild }
|
||||
| '(' Pattern ')' { $2 }
|
||||
|
||||
|
||||
CommaPattern :: { CommaPattern }
|
||||
CommaPattern : Pattern { CommaPattern $1 }
|
||||
|
||||
|
||||
ListCommaPattern :: { [CommaPattern] }
|
||||
ListCommaPattern : CommaPattern { (:[]) $1 }
|
||||
| CommaPattern ',' ListCommaPattern { (:) $1 $3 }
|
||||
|
||||
|
||||
ListPattern :: { [Pattern] }
|
||||
ListPattern : {- empty -} { [] }
|
||||
| ListPattern Pattern3 { flip (:) $1 $2 }
|
||||
|
||||
|
||||
FieldPattern :: { FieldPattern }
|
||||
FieldPattern : Ident '=' Pattern { FieldPattern $1 $3 }
|
||||
|
||||
|
||||
ListFieldPattern :: { [FieldPattern] }
|
||||
ListFieldPattern : {- empty -} { [] }
|
||||
| FieldPattern { (:[]) $1 }
|
||||
| FieldPattern ';' ListFieldPattern { (:) $1 $3 }
|
||||
|
||||
|
||||
Exp :: { Exp }
|
||||
Exp : '(' VarOrWild ':' Exp ')' '->' Exp { EPi $2 $4 $7 }
|
||||
| Exp1 '->' Exp { EPiNoVar $1 $3 }
|
||||
| Exp1 { $1 }
|
||||
|
||||
|
||||
VarOrWild :: { VarOrWild }
|
||||
VarOrWild : Ident { VVar $1 }
|
||||
| '_' { VWild }
|
||||
|
||||
|
||||
Exp1 :: { Exp }
|
||||
Exp1 : '\\' VarOrWild '->' Exp1 { EAbs $2 $4 }
|
||||
| 'let' '{' ListLetDef '}' 'in' Exp1 { ELet $3 $6 }
|
||||
| 'case' Exp 'of' '{' ListCase '}' { ECase $2 $5 }
|
||||
| 'if' Exp 'then' Exp 'else' Exp1 { EIf $2 $4 $6 }
|
||||
| 'do' '{' ListBind Exp '}' { EDo (reverse $3) $4 }
|
||||
| Exp2 { $1 }
|
||||
|
||||
|
||||
LetDef :: { LetDef }
|
||||
LetDef : Ident '=' Exp { LetDef $1 $3 }
|
||||
|
||||
|
||||
ListLetDef :: { [LetDef] }
|
||||
ListLetDef : {- empty -} { [] }
|
||||
| LetDef { (:[]) $1 }
|
||||
| LetDef ';' ListLetDef { (:) $1 $3 }
|
||||
|
||||
|
||||
Case :: { Case }
|
||||
Case : Pattern Guard '->' Exp { Case $1 $2 $4 }
|
||||
|
||||
|
||||
ListCase :: { [Case] }
|
||||
ListCase : {- empty -} { [] }
|
||||
| Case { (:[]) $1 }
|
||||
| Case ';' ListCase { (:) $1 $3 }
|
||||
|
||||
|
||||
Bind :: { Bind }
|
||||
Bind : VarOrWild '<-' Exp { BindVar $1 $3 }
|
||||
| Exp { BindNoVar $1 }
|
||||
|
||||
|
||||
ListBind :: { [Bind] }
|
||||
ListBind : {- empty -} { [] }
|
||||
| ListBind Bind ';' { flip (:) $1 $2 }
|
||||
|
||||
|
||||
Exp3 :: { Exp }
|
||||
Exp3 : Exp3 '>>=' Exp4 { EBind $1 $3 }
|
||||
| Exp3 '>>' Exp4 { EBindC $1 $3 }
|
||||
| Exp4 { $1 }
|
||||
|
||||
|
||||
Exp4 :: { Exp }
|
||||
Exp4 : Exp5 '||' Exp4 { EOr $1 $3 }
|
||||
| Exp5 { $1 }
|
||||
|
||||
|
||||
Exp5 :: { Exp }
|
||||
Exp5 : Exp6 '&&' Exp5 { EAnd $1 $3 }
|
||||
| Exp6 { $1 }
|
||||
|
||||
|
||||
Exp6 :: { Exp }
|
||||
Exp6 : Exp7 '==' Exp7 { EEq $1 $3 }
|
||||
| Exp7 '/=' Exp7 { ENe $1 $3 }
|
||||
| Exp7 '<' Exp7 { ELt $1 $3 }
|
||||
| Exp7 '<=' Exp7 { ELe $1 $3 }
|
||||
| Exp7 '>' Exp7 { EGt $1 $3 }
|
||||
| Exp7 '>=' Exp7 { EGe $1 $3 }
|
||||
| Exp7 { $1 }
|
||||
|
||||
|
||||
Exp7 :: { Exp }
|
||||
Exp7 : Exp8 '::' Exp7 { EListCons $1 $3 }
|
||||
| Exp8 { $1 }
|
||||
|
||||
|
||||
Exp8 :: { Exp }
|
||||
Exp8 : Exp8 '+' Exp9 { EAdd $1 $3 }
|
||||
| Exp8 '-' Exp9 { ESub $1 $3 }
|
||||
| Exp9 { $1 }
|
||||
|
||||
|
||||
Exp9 :: { Exp }
|
||||
Exp9 : Exp9 '*' Exp10 { EMul $1 $3 }
|
||||
| Exp9 '/' Exp10 { EDiv $1 $3 }
|
||||
| Exp9 '%' Exp10 { EMod $1 $3 }
|
||||
| Exp10 { $1 }
|
||||
|
||||
|
||||
Exp10 :: { Exp }
|
||||
Exp10 : '-' Exp10 { ENeg $2 }
|
||||
| Exp11 { $1 }
|
||||
|
||||
|
||||
Exp11 :: { Exp }
|
||||
Exp11 : Exp11 Exp12 { EApp $1 $2 }
|
||||
| Exp12 { $1 }
|
||||
|
||||
|
||||
Exp12 :: { Exp }
|
||||
Exp12 : Exp12 '.' Ident { EProj $1 $3 }
|
||||
| Exp13 { $1 }
|
||||
|
||||
|
||||
Exp13 :: { Exp }
|
||||
Exp13 : 'sig' '{' ListFieldType '}' { ERecType $3 }
|
||||
| 'rec' '{' ListFieldValue '}' { ERec $3 }
|
||||
| '[' ']' { EEmptyList }
|
||||
| '[' ListExp ']' { EList $2 }
|
||||
| '(' Exp ',' ListExp ')' { ETuple $2 $4 }
|
||||
| Ident { EVar $1 }
|
||||
| 'Type' { EType }
|
||||
| String { EStr $1 }
|
||||
| Integer { EInteger $1 }
|
||||
| Double { EDouble $1 }
|
||||
| '?' { EMeta }
|
||||
| '(' Exp ')' { $2 }
|
||||
|
||||
|
||||
FieldType :: { FieldType }
|
||||
FieldType : Ident ':' Exp { FieldType $1 $3 }
|
||||
|
||||
|
||||
ListFieldType :: { [FieldType] }
|
||||
ListFieldType : {- empty -} { [] }
|
||||
| FieldType { (:[]) $1 }
|
||||
| FieldType ';' ListFieldType { (:) $1 $3 }
|
||||
|
||||
|
||||
FieldValue :: { FieldValue }
|
||||
FieldValue : Ident '=' Exp { FieldValue $1 $3 }
|
||||
|
||||
|
||||
ListFieldValue :: { [FieldValue] }
|
||||
ListFieldValue : {- empty -} { [] }
|
||||
| FieldValue { (:[]) $1 }
|
||||
| FieldValue ';' ListFieldValue { (:) $1 $3 }
|
||||
|
||||
|
||||
Exp2 :: { Exp }
|
||||
Exp2 : Exp3 { $1 }
|
||||
|
||||
|
||||
ListExp :: { [Exp] }
|
||||
ListExp : Exp { (:[]) $1 }
|
||||
| Exp ',' ListExp { (:) $1 $3 }
|
||||
|
||||
|
||||
|
||||
{
|
||||
|
||||
returnM :: a -> Err a
|
||||
returnM = return
|
||||
|
||||
thenM :: Err a -> (a -> Err b) -> Err b
|
||||
thenM = (>>=)
|
||||
|
||||
happyError :: [Token] -> Err a
|
||||
happyError ts =
|
||||
Bad $ "syntax error at " ++ tokenPos ts ++ if null ts then [] else (" before " ++ unwords (map prToken (take 4 ts)))
|
||||
|
||||
myLexer = tokens
|
||||
}
|
||||
|
||||
206
src-3.0/Transfer/Syntax/Print.hs
Normal file
206
src-3.0/Transfer/Syntax/Print.hs
Normal file
@@ -0,0 +1,206 @@
|
||||
{-# OPTIONS_GHC -fglasgow-exts #-}
|
||||
module Transfer.Syntax.Print where
|
||||
|
||||
-- pretty-printer generated by the BNF converter
|
||||
|
||||
import Transfer.Syntax.Abs
|
||||
import Data.Char
|
||||
import Data.List (intersperse)
|
||||
|
||||
-- the top-level printing method
|
||||
printTree :: Print a => a -> String
|
||||
printTree = render . prt 0
|
||||
|
||||
type Doc = [ShowS] -> [ShowS]
|
||||
|
||||
doc :: ShowS -> Doc
|
||||
doc = (:)
|
||||
|
||||
render :: Doc -> String
|
||||
render d = rend 0 (map ($ "") $ d []) "" where
|
||||
rend i ss = case ss of
|
||||
"[" :ts -> showChar '[' . rend i ts
|
||||
"(" :ts -> showChar '(' . rend i ts
|
||||
"{" :ts -> showChar '{' . new (i+1) . rend (i+1) ts
|
||||
"}" : ";":ts -> new (i-1) . space "}" . showChar ';' . new (i-1) . rend (i-1) ts
|
||||
"}" :ts -> new (i-1) . showChar '}' . new (i-1) . rend (i-1) ts
|
||||
";" :ts -> showChar ';' . new i . rend i ts
|
||||
t : "," :ts -> showString t . space "," . rend i ts
|
||||
t : ")" :ts -> showString t . showChar ')' . rend i ts
|
||||
t : "]" :ts -> showString t . showChar ']' . rend i ts
|
||||
t :ts -> space t . rend i ts
|
||||
_ -> id
|
||||
new i = showChar '\n' . replicateS (2*i) (showChar ' ') . dropWhile isSpace
|
||||
space t = showString t . (\s -> if null s then "" else (' ':s))
|
||||
|
||||
parenth :: Doc -> Doc
|
||||
parenth ss = doc (showChar '(') . ss . doc (showChar ')')
|
||||
|
||||
concatS :: [ShowS] -> ShowS
|
||||
concatS = foldr (.) id
|
||||
|
||||
concatD :: [Doc] -> Doc
|
||||
concatD = foldr (.) id
|
||||
|
||||
unwordsD :: [Doc] -> Doc
|
||||
unwordsD = concatD . intersperse (doc (showChar ' '))
|
||||
|
||||
replicateS :: Int -> ShowS -> ShowS
|
||||
replicateS n f = concatS (replicate n f)
|
||||
|
||||
-- the printer class does the job
|
||||
class Print a where
|
||||
prt :: Int -> a -> Doc
|
||||
|
||||
instance Print Char where
|
||||
prt _ s = doc (showChar '\'' . mkEsc '\'' s . showChar '\'')
|
||||
|
||||
instance Print String where
|
||||
prt _ s = doc (showChar '"' . concatS (map (mkEsc '"') s) . showChar '"')
|
||||
|
||||
mkEsc :: Char -> Char -> ShowS
|
||||
mkEsc q s = case s of
|
||||
_ | s == q -> showChar '\\' . showChar s
|
||||
'\\'-> showString "\\\\"
|
||||
'\n' -> showString "\\n"
|
||||
'\t' -> showString "\\t"
|
||||
_ -> showChar s
|
||||
|
||||
prPrec :: Int -> Int -> Doc -> Doc
|
||||
prPrec i j = if j<i then parenth else id
|
||||
|
||||
|
||||
instance Print Integer where
|
||||
prt _ x = doc (shows x)
|
||||
|
||||
|
||||
instance Print Double where
|
||||
prt _ x = doc (shows x)
|
||||
|
||||
|
||||
instance Print (Tree c) where
|
||||
prt _i e = case e of
|
||||
Module imports decls -> prPrec _i 0 (concatD [prt 0 imports , prt 0 decls])
|
||||
Import i -> prPrec _i 0 (concatD [doc (showString "import") , prt 0 i])
|
||||
DataDecl i exp consdecls -> prPrec _i 0 (concatD [doc (showString "data") , prt 0 i , doc (showString ":") , prt 0 exp , doc (showString "where") , doc (showString "{") , prt 0 consdecls , doc (showString "}")])
|
||||
TypeDecl i exp -> prPrec _i 0 (concatD [prt 0 i , doc (showString ":") , prt 0 exp])
|
||||
ValueDecl i patterns guard exp -> prPrec _i 0 (concatD [prt 0 i , prt 0 patterns , prt 0 guard , doc (showString "=") , prt 0 exp])
|
||||
DeriveDecl i0 i1 -> prPrec _i 0 (concatD [doc (showString "derive") , prt 0 i0 , prt 0 i1])
|
||||
ConsDecl i exp -> prPrec _i 0 (concatD [prt 0 i , doc (showString ":") , prt 0 exp])
|
||||
GuardExp exp -> prPrec _i 0 (concatD [doc (showString "|") , prt 1 exp])
|
||||
GuardNo -> prPrec _i 0 (concatD [])
|
||||
POr pattern0 pattern1 -> prPrec _i 0 (concatD [prt 1 pattern0 , doc (showString "||") , prt 0 pattern1])
|
||||
PListCons pattern0 pattern1 -> prPrec _i 1 (concatD [prt 2 pattern0 , doc (showString "::") , prt 1 pattern1])
|
||||
PConsTop i pattern patterns -> prPrec _i 2 (concatD [prt 0 i , prt 3 pattern , prt 0 patterns])
|
||||
PCons i patterns -> prPrec _i 3 (concatD [doc (showString "(") , prt 0 i , prt 0 patterns , doc (showString ")")])
|
||||
PRec fieldpatterns -> prPrec _i 3 (concatD [doc (showString "rec") , doc (showString "{") , prt 0 fieldpatterns , doc (showString "}")])
|
||||
PEmptyList -> prPrec _i 3 (concatD [doc (showString "[") , doc (showString "]")])
|
||||
PList commapatterns -> prPrec _i 3 (concatD [doc (showString "[") , prt 0 commapatterns , doc (showString "]")])
|
||||
PTuple commapattern commapatterns -> prPrec _i 3 (concatD [doc (showString "(") , prt 0 commapattern , doc (showString ",") , prt 0 commapatterns , doc (showString ")")])
|
||||
PStr str -> prPrec _i 3 (concatD [prt 0 str])
|
||||
PInt n -> prPrec _i 3 (concatD [prt 0 n])
|
||||
PVar i -> prPrec _i 3 (concatD [prt 0 i])
|
||||
PWild -> prPrec _i 3 (concatD [doc (showString "_")])
|
||||
CommaPattern pattern -> prPrec _i 0 (concatD [prt 0 pattern])
|
||||
FieldPattern i pattern -> prPrec _i 0 (concatD [prt 0 i , doc (showString "=") , prt 0 pattern])
|
||||
EPi varorwild exp0 exp1 -> prPrec _i 0 (concatD [doc (showString "(") , prt 0 varorwild , doc (showString ":") , prt 0 exp0 , doc (showString ")") , doc (showString "->") , prt 0 exp1])
|
||||
EPiNoVar exp0 exp1 -> prPrec _i 0 (concatD [prt 1 exp0 , doc (showString "->") , prt 0 exp1])
|
||||
EAbs varorwild exp -> prPrec _i 1 (concatD [doc (showString "\\") , prt 0 varorwild , doc (showString "->") , prt 1 exp])
|
||||
ELet letdefs exp -> prPrec _i 1 (concatD [doc (showString "let") , doc (showString "{") , prt 0 letdefs , doc (showString "}") , doc (showString "in") , prt 1 exp])
|
||||
ECase exp cases -> prPrec _i 1 (concatD [doc (showString "case") , prt 0 exp , doc (showString "of") , doc (showString "{") , prt 0 cases , doc (showString "}")])
|
||||
EIf exp0 exp1 exp2 -> prPrec _i 1 (concatD [doc (showString "if") , prt 0 exp0 , doc (showString "then") , prt 0 exp1 , doc (showString "else") , prt 1 exp2])
|
||||
EDo binds exp -> prPrec _i 1 (concatD [doc (showString "do") , doc (showString "{") , prt 0 binds , prt 0 exp , doc (showString "}")])
|
||||
EBind exp0 exp1 -> prPrec _i 3 (concatD [prt 3 exp0 , doc (showString ">>=") , prt 4 exp1])
|
||||
EBindC exp0 exp1 -> prPrec _i 3 (concatD [prt 3 exp0 , doc (showString ">>") , prt 4 exp1])
|
||||
EOr exp0 exp1 -> prPrec _i 4 (concatD [prt 5 exp0 , doc (showString "||") , prt 4 exp1])
|
||||
EAnd exp0 exp1 -> prPrec _i 5 (concatD [prt 6 exp0 , doc (showString "&&") , prt 5 exp1])
|
||||
EEq exp0 exp1 -> prPrec _i 6 (concatD [prt 7 exp0 , doc (showString "==") , prt 7 exp1])
|
||||
ENe exp0 exp1 -> prPrec _i 6 (concatD [prt 7 exp0 , doc (showString "/=") , prt 7 exp1])
|
||||
ELt exp0 exp1 -> prPrec _i 6 (concatD [prt 7 exp0 , doc (showString "<") , prt 7 exp1])
|
||||
ELe exp0 exp1 -> prPrec _i 6 (concatD [prt 7 exp0 , doc (showString "<=") , prt 7 exp1])
|
||||
EGt exp0 exp1 -> prPrec _i 6 (concatD [prt 7 exp0 , doc (showString ">") , prt 7 exp1])
|
||||
EGe exp0 exp1 -> prPrec _i 6 (concatD [prt 7 exp0 , doc (showString ">=") , prt 7 exp1])
|
||||
EListCons exp0 exp1 -> prPrec _i 7 (concatD [prt 8 exp0 , doc (showString "::") , prt 7 exp1])
|
||||
EAdd exp0 exp1 -> prPrec _i 8 (concatD [prt 8 exp0 , doc (showString "+") , prt 9 exp1])
|
||||
ESub exp0 exp1 -> prPrec _i 8 (concatD [prt 8 exp0 , doc (showString "-") , prt 9 exp1])
|
||||
EMul exp0 exp1 -> prPrec _i 9 (concatD [prt 9 exp0 , doc (showString "*") , prt 10 exp1])
|
||||
EDiv exp0 exp1 -> prPrec _i 9 (concatD [prt 9 exp0 , doc (showString "/") , prt 10 exp1])
|
||||
EMod exp0 exp1 -> prPrec _i 9 (concatD [prt 9 exp0 , doc (showString "%") , prt 10 exp1])
|
||||
ENeg exp -> prPrec _i 10 (concatD [doc (showString "-") , prt 10 exp])
|
||||
EApp exp0 exp1 -> prPrec _i 11 (concatD [prt 11 exp0 , prt 12 exp1])
|
||||
EProj exp i -> prPrec _i 12 (concatD [prt 12 exp , doc (showString ".") , prt 0 i])
|
||||
ERecType fieldtypes -> prPrec _i 13 (concatD [doc (showString "sig") , doc (showString "{") , prt 0 fieldtypes , doc (showString "}")])
|
||||
ERec fieldvalues -> prPrec _i 13 (concatD [doc (showString "rec") , doc (showString "{") , prt 0 fieldvalues , doc (showString "}")])
|
||||
EEmptyList -> prPrec _i 13 (concatD [doc (showString "[") , doc (showString "]")])
|
||||
EList exps -> prPrec _i 13 (concatD [doc (showString "[") , prt 0 exps , doc (showString "]")])
|
||||
ETuple exp exps -> prPrec _i 13 (concatD [doc (showString "(") , prt 0 exp , doc (showString ",") , prt 0 exps , doc (showString ")")])
|
||||
EVar i -> prPrec _i 13 (concatD [prt 0 i])
|
||||
EType -> prPrec _i 13 (concatD [doc (showString "Type")])
|
||||
EStr str -> prPrec _i 13 (concatD [prt 0 str])
|
||||
EInteger n -> prPrec _i 13 (concatD [prt 0 n])
|
||||
EDouble d -> prPrec _i 13 (concatD [prt 0 d])
|
||||
EMeta -> prPrec _i 13 (concatD [doc (showString "?")])
|
||||
VVar i -> prPrec _i 0 (concatD [prt 0 i])
|
||||
VWild -> prPrec _i 0 (concatD [doc (showString "_")])
|
||||
LetDef i exp -> prPrec _i 0 (concatD [prt 0 i , doc (showString "=") , prt 0 exp])
|
||||
Case pattern guard exp -> prPrec _i 0 (concatD [prt 0 pattern , prt 0 guard , doc (showString "->") , prt 0 exp])
|
||||
BindVar varorwild exp -> prPrec _i 0 (concatD [prt 0 varorwild , doc (showString "<-") , prt 0 exp])
|
||||
BindNoVar exp -> prPrec _i 0 (concatD [prt 0 exp])
|
||||
FieldType i exp -> prPrec _i 0 (concatD [prt 0 i , doc (showString ":") , prt 0 exp])
|
||||
FieldValue i exp -> prPrec _i 0 (concatD [prt 0 i , doc (showString "=") , prt 0 exp])
|
||||
Ident str -> prPrec _i 0 (doc (showString str))
|
||||
|
||||
instance Print [Import] where
|
||||
prt _ es = case es of
|
||||
[] -> (concatD [])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
instance Print [Decl] where
|
||||
prt _ es = case es of
|
||||
[] -> (concatD [])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
instance Print [ConsDecl] where
|
||||
prt _ es = case es of
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
instance Print [CommaPattern] where
|
||||
prt _ es = case es of
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
|
||||
instance Print [Pattern] where
|
||||
prt _ es = case es of
|
||||
[] -> (concatD [])
|
||||
x:xs -> (concatD [prt 3 x , prt 0 xs])
|
||||
instance Print [FieldPattern] where
|
||||
prt _ es = case es of
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
instance Print [LetDef] where
|
||||
prt _ es = case es of
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
instance Print [Case] where
|
||||
prt _ es = case es of
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
instance Print [Bind] where
|
||||
prt _ es = case es of
|
||||
[] -> (concatD [])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
instance Print [FieldType] where
|
||||
prt _ es = case es of
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
instance Print [FieldValue] where
|
||||
prt _ es = case es of
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
instance Print [Exp] where
|
||||
prt _ es = case es of
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
|
||||
29
src-3.0/Transfer/Syntax/ResolveLayout.hs
Normal file
29
src-3.0/Transfer/Syntax/ResolveLayout.hs
Normal file
@@ -0,0 +1,29 @@
|
||||
module Main where
|
||||
|
||||
import System.Environment (getArgs)
|
||||
|
||||
import Transfer.Syntax.Lex
|
||||
import Transfer.Syntax.Layout
|
||||
|
||||
prTokens :: [Token] -> String
|
||||
prTokens = prTokens_ 1 1
|
||||
where
|
||||
prTokens_ _ _ [] = ""
|
||||
prTokens_ l c (t@(PT (Pn _ l' c') _):ts) =
|
||||
replicate (l'-l) '\n'
|
||||
++ replicate (if l' == l then c'-c else c'-1) ' '
|
||||
++ s ++ prTokens_ l' (c'+length s) ts
|
||||
where s = prToken t
|
||||
-- prTokens_ l c (Err p:ts) =
|
||||
|
||||
layout :: String -> String
|
||||
layout s = prTokens ts'
|
||||
-- ++ "\n" ++ show ts'
|
||||
where ts = tokens s
|
||||
ts' = resolveLayout True ts
|
||||
|
||||
main :: IO ()
|
||||
main = do args <- getArgs
|
||||
case args of
|
||||
[] -> getContents >>= putStrLn . layout
|
||||
fs -> mapM_ (\f -> readFile f >>= putStrLn . layout) fs
|
||||
200
src-3.0/Transfer/Syntax/Skel.hs
Normal file
200
src-3.0/Transfer/Syntax/Skel.hs
Normal file
@@ -0,0 +1,200 @@
|
||||
module Transfer.Syntax.Skel where
|
||||
|
||||
-- Haskell module generated by the BNF converter
|
||||
|
||||
import Transfer.Syntax.Abs
|
||||
import Transfer.ErrM
|
||||
type Result = Err String
|
||||
|
||||
failure :: Show a => a -> Result
|
||||
failure x = Bad $ "Undefined case: " ++ show x
|
||||
|
||||
transTree :: Tree c -> Result
|
||||
transTree t = case t of
|
||||
Module imports decls -> failure t
|
||||
Import i -> failure t
|
||||
DataDecl i exp consdecls -> failure t
|
||||
TypeDecl i exp -> failure t
|
||||
ValueDecl i patterns guard exp -> failure t
|
||||
DeriveDecl i0 i1 -> failure t
|
||||
ConsDecl i exp -> failure t
|
||||
GuardExp exp -> failure t
|
||||
GuardNo -> failure t
|
||||
POr pattern0 pattern1 -> failure t
|
||||
PListCons pattern0 pattern1 -> failure t
|
||||
PConsTop i pattern patterns -> failure t
|
||||
PCons i patterns -> failure t
|
||||
PRec fieldpatterns -> failure t
|
||||
PEmptyList -> failure t
|
||||
PList commapatterns -> failure t
|
||||
PTuple commapattern commapatterns -> failure t
|
||||
PStr str -> failure t
|
||||
PInt n -> failure t
|
||||
PVar i -> failure t
|
||||
PWild -> failure t
|
||||
CommaPattern pattern -> failure t
|
||||
FieldPattern i pattern -> failure t
|
||||
EPi varorwild exp0 exp1 -> failure t
|
||||
EPiNoVar exp0 exp1 -> failure t
|
||||
EAbs varorwild exp -> failure t
|
||||
ELet letdefs exp -> failure t
|
||||
ECase exp cases -> failure t
|
||||
EIf exp0 exp1 exp2 -> failure t
|
||||
EDo binds exp -> failure t
|
||||
EBind exp0 exp1 -> failure t
|
||||
EBindC exp0 exp1 -> failure t
|
||||
EOr exp0 exp1 -> failure t
|
||||
EAnd exp0 exp1 -> failure t
|
||||
EEq exp0 exp1 -> failure t
|
||||
ENe exp0 exp1 -> failure t
|
||||
ELt exp0 exp1 -> failure t
|
||||
ELe exp0 exp1 -> failure t
|
||||
EGt exp0 exp1 -> failure t
|
||||
EGe exp0 exp1 -> failure t
|
||||
EListCons exp0 exp1 -> failure t
|
||||
EAdd exp0 exp1 -> failure t
|
||||
ESub exp0 exp1 -> failure t
|
||||
EMul exp0 exp1 -> failure t
|
||||
EDiv exp0 exp1 -> failure t
|
||||
EMod exp0 exp1 -> failure t
|
||||
ENeg exp -> failure t
|
||||
EApp exp0 exp1 -> failure t
|
||||
EProj exp i -> failure t
|
||||
ERecType fieldtypes -> failure t
|
||||
ERec fieldvalues -> failure t
|
||||
EEmptyList -> failure t
|
||||
EList exps -> failure t
|
||||
ETuple exp exps -> failure t
|
||||
EVar i -> failure t
|
||||
EType -> failure t
|
||||
EStr str -> failure t
|
||||
EInteger n -> failure t
|
||||
EDouble d -> failure t
|
||||
EMeta -> failure t
|
||||
VVar i -> failure t
|
||||
VWild -> failure t
|
||||
LetDef i exp -> failure t
|
||||
Case pattern guard exp -> failure t
|
||||
BindVar varorwild exp -> failure t
|
||||
BindNoVar exp -> failure t
|
||||
FieldType i exp -> failure t
|
||||
FieldValue i exp -> failure t
|
||||
Ident str -> failure t
|
||||
|
||||
transModule :: Module -> Result
|
||||
transModule t = case t of
|
||||
Module imports decls -> failure t
|
||||
|
||||
transImport :: Import -> Result
|
||||
transImport t = case t of
|
||||
Import i -> failure t
|
||||
|
||||
transDecl :: Decl -> Result
|
||||
transDecl t = case t of
|
||||
DataDecl i exp consdecls -> failure t
|
||||
TypeDecl i exp -> failure t
|
||||
ValueDecl i patterns guard exp -> failure t
|
||||
DeriveDecl i0 i1 -> failure t
|
||||
|
||||
transConsDecl :: ConsDecl -> Result
|
||||
transConsDecl t = case t of
|
||||
ConsDecl i exp -> failure t
|
||||
|
||||
transGuard :: Guard -> Result
|
||||
transGuard t = case t of
|
||||
GuardExp exp -> failure t
|
||||
GuardNo -> failure t
|
||||
|
||||
transPattern :: Pattern -> Result
|
||||
transPattern t = case t of
|
||||
POr pattern0 pattern1 -> failure t
|
||||
PListCons pattern0 pattern1 -> failure t
|
||||
PConsTop i pattern patterns -> failure t
|
||||
PCons i patterns -> failure t
|
||||
PRec fieldpatterns -> failure t
|
||||
PEmptyList -> failure t
|
||||
PList commapatterns -> failure t
|
||||
PTuple commapattern commapatterns -> failure t
|
||||
PStr str -> failure t
|
||||
PInt n -> failure t
|
||||
PVar i -> failure t
|
||||
PWild -> failure t
|
||||
|
||||
transCommaPattern :: CommaPattern -> Result
|
||||
transCommaPattern t = case t of
|
||||
CommaPattern pattern -> failure t
|
||||
|
||||
transFieldPattern :: FieldPattern -> Result
|
||||
transFieldPattern t = case t of
|
||||
FieldPattern i pattern -> failure t
|
||||
|
||||
transExp :: Exp -> Result
|
||||
transExp t = case t of
|
||||
EPi varorwild exp0 exp1 -> failure t
|
||||
EPiNoVar exp0 exp1 -> failure t
|
||||
EAbs varorwild exp -> failure t
|
||||
ELet letdefs exp -> failure t
|
||||
ECase exp cases -> failure t
|
||||
EIf exp0 exp1 exp2 -> failure t
|
||||
EDo binds exp -> failure t
|
||||
EBind exp0 exp1 -> failure t
|
||||
EBindC exp0 exp1 -> failure t
|
||||
EOr exp0 exp1 -> failure t
|
||||
EAnd exp0 exp1 -> failure t
|
||||
EEq exp0 exp1 -> failure t
|
||||
ENe exp0 exp1 -> failure t
|
||||
ELt exp0 exp1 -> failure t
|
||||
ELe exp0 exp1 -> failure t
|
||||
EGt exp0 exp1 -> failure t
|
||||
EGe exp0 exp1 -> failure t
|
||||
EListCons exp0 exp1 -> failure t
|
||||
EAdd exp0 exp1 -> failure t
|
||||
ESub exp0 exp1 -> failure t
|
||||
EMul exp0 exp1 -> failure t
|
||||
EDiv exp0 exp1 -> failure t
|
||||
EMod exp0 exp1 -> failure t
|
||||
ENeg exp -> failure t
|
||||
EApp exp0 exp1 -> failure t
|
||||
EProj exp i -> failure t
|
||||
ERecType fieldtypes -> failure t
|
||||
ERec fieldvalues -> failure t
|
||||
EEmptyList -> failure t
|
||||
EList exps -> failure t
|
||||
ETuple exp exps -> failure t
|
||||
EVar i -> failure t
|
||||
EType -> failure t
|
||||
EStr str -> failure t
|
||||
EInteger n -> failure t
|
||||
EDouble d -> failure t
|
||||
EMeta -> failure t
|
||||
|
||||
transVarOrWild :: VarOrWild -> Result
|
||||
transVarOrWild t = case t of
|
||||
VVar i -> failure t
|
||||
VWild -> failure t
|
||||
|
||||
transLetDef :: LetDef -> Result
|
||||
transLetDef t = case t of
|
||||
LetDef i exp -> failure t
|
||||
|
||||
transCase :: Case -> Result
|
||||
transCase t = case t of
|
||||
Case pattern guard exp -> failure t
|
||||
|
||||
transBind :: Bind -> Result
|
||||
transBind t = case t of
|
||||
BindVar varorwild exp -> failure t
|
||||
BindNoVar exp -> failure t
|
||||
|
||||
transFieldType :: FieldType -> Result
|
||||
transFieldType t = case t of
|
||||
FieldType i exp -> failure t
|
||||
|
||||
transFieldValue :: FieldValue -> Result
|
||||
transFieldValue t = case t of
|
||||
FieldValue i exp -> failure t
|
||||
|
||||
transIdent :: Ident -> Result
|
||||
transIdent t = case t of
|
||||
Ident str -> failure t
|
||||
|
||||
147
src-3.0/Transfer/Syntax/Syntax.cf
Normal file
147
src-3.0/Transfer/Syntax/Syntax.cf
Normal file
@@ -0,0 +1,147 @@
|
||||
entrypoints Module, Exp ;
|
||||
|
||||
layout "let", "where", "of","rec", "sig", "do" ;
|
||||
layout stop "in" ;
|
||||
layout toplevel ;
|
||||
|
||||
comment "--" ;
|
||||
comment "{-" "-}" ;
|
||||
|
||||
Module. Module ::= [Import] [Decl] ;
|
||||
|
||||
Import. Import ::= "import" Ident ;
|
||||
-- FIXME: this is terminator to ensure that the pretty printer
|
||||
-- produces a semicolon after the last import. This could cause
|
||||
-- problems in a program which only does imports and uses layout syntax.
|
||||
terminator Import ";" ;
|
||||
|
||||
DataDecl. Decl ::= "data" Ident ":" Exp "where" "{" [ConsDecl] "}" ;
|
||||
TypeDecl. Decl ::= Ident ":" Exp ;
|
||||
ValueDecl. Decl ::= Ident [Pattern] Guard "=" Exp ;
|
||||
DeriveDecl. Decl ::= "derive" Ident Ident ;
|
||||
terminator Decl ";" ;
|
||||
|
||||
ConsDecl. ConsDecl ::= Ident ":" Exp ;
|
||||
separator ConsDecl ";" ;
|
||||
|
||||
GuardExp. Guard ::= "|" Exp1 ;
|
||||
GuardNo. Guard ::= ;
|
||||
|
||||
-- Disjunctive patterns.
|
||||
POr. Pattern ::= Pattern1 "||" Pattern ;
|
||||
|
||||
-- List constructor patterns
|
||||
PListCons. Pattern1 ::= Pattern2 "::" Pattern1 ;
|
||||
|
||||
-- Hack: constructor applied to at least one pattern
|
||||
-- this is to separate it from variable patterns
|
||||
PConsTop. Pattern2 ::= Ident Pattern3 [Pattern] ;
|
||||
|
||||
-- Real constructor pattern
|
||||
internal PCons. Pattern3 ::= "(" Ident [Pattern] ")" ;
|
||||
|
||||
-- Record patterns
|
||||
PRec. Pattern3 ::= "rec" "{" [FieldPattern] "}";
|
||||
|
||||
-- List patterns
|
||||
PEmptyList. Pattern3 ::= "[" "]" ;
|
||||
PList. Pattern3 ::= "[" [CommaPattern] "]" ;
|
||||
|
||||
-- Tuple patterns
|
||||
PTuple. Pattern3 ::= "(" CommaPattern "," [CommaPattern] ")" ;
|
||||
|
||||
-- hack to allow a different [Pattern] from the one defined
|
||||
-- for constructor patterns
|
||||
CommaPattern. CommaPattern ::= Pattern ;
|
||||
separator nonempty CommaPattern "," ;
|
||||
|
||||
-- String literal patterns
|
||||
PStr. Pattern3 ::= String ;
|
||||
-- Integer literal patterns
|
||||
PInt. Pattern3 ::= Integer ;
|
||||
-- Variable patterns
|
||||
PVar. Pattern3 ::= Ident ;
|
||||
-- Wild card patterns
|
||||
PWild. Pattern3 ::= "_" ;
|
||||
|
||||
coercions Pattern 3 ;
|
||||
|
||||
[]. [Pattern] ::= ;
|
||||
(:). [Pattern] ::= Pattern3 [Pattern] ;
|
||||
|
||||
FieldPattern. FieldPattern ::= Ident "=" Pattern ;
|
||||
separator FieldPattern ";" ;
|
||||
|
||||
-- Function types have precedence < 1 to keep the
|
||||
-- "->" from conflicting with the "->" after guards
|
||||
EPi. Exp ::= "(" VarOrWild ":" Exp ")" "->" Exp ;
|
||||
EPiNoVar. Exp ::= Exp1 "->" Exp ;
|
||||
VVar. VarOrWild ::= Ident ;
|
||||
VWild. VarOrWild ::= "_" ;
|
||||
|
||||
EAbs. Exp1 ::= "\\" VarOrWild "->" Exp1 ;
|
||||
ELet. Exp1 ::= "let" "{" [LetDef] "}" "in" Exp1 ;
|
||||
LetDef. LetDef ::= Ident "=" Exp ;
|
||||
separator LetDef ";" ;
|
||||
ECase. Exp1 ::= "case" Exp "of" "{" [Case] "}" ;
|
||||
Case. Case ::= Pattern Guard "->" Exp ;
|
||||
separator Case ";" ;
|
||||
EIf. Exp1 ::= "if" Exp "then" Exp "else" Exp1 ;
|
||||
EDo. Exp1 ::= "do" "{" [Bind] Exp "}" ;
|
||||
BindVar. Bind ::= VarOrWild "<-" Exp ;
|
||||
BindNoVar. Bind ::= Exp ;
|
||||
terminator Bind ";" ;
|
||||
|
||||
EBind. Exp3 ::= Exp3 ">>=" Exp4 ;
|
||||
EBindC. Exp3 ::= Exp3 ">>" Exp4 ;
|
||||
|
||||
EOr. Exp4 ::= Exp5 "||" Exp4 ;
|
||||
|
||||
EAnd. Exp5 ::= Exp6 "&&" Exp5 ;
|
||||
|
||||
EEq. Exp6 ::= Exp7 "==" Exp7 ;
|
||||
ENe. Exp6 ::= Exp7 "/=" Exp7 ;
|
||||
ELt. Exp6 ::= Exp7 "<" Exp7 ;
|
||||
ELe. Exp6 ::= Exp7 "<=" Exp7 ;
|
||||
EGt. Exp6 ::= Exp7 ">" Exp7 ;
|
||||
EGe. Exp6 ::= Exp7 ">=" Exp7 ;
|
||||
|
||||
EListCons. Exp7 ::= Exp8 "::" Exp7 ;
|
||||
|
||||
EAdd. Exp8 ::= Exp8 "+" Exp9 ;
|
||||
ESub. Exp8 ::= Exp8 "-" Exp9 ;
|
||||
|
||||
EMul. Exp9 ::= Exp9 "*" Exp10 ;
|
||||
EDiv. Exp9 ::= Exp9 "/" Exp10 ;
|
||||
EMod. Exp9 ::= Exp9 "%" Exp10 ;
|
||||
|
||||
ENeg. Exp10 ::= "-" Exp10 ;
|
||||
|
||||
EApp. Exp11 ::= Exp11 Exp12 ;
|
||||
|
||||
EProj. Exp12 ::= Exp12 "." Ident ;
|
||||
|
||||
ERecType. Exp13 ::= "sig" "{" [FieldType] "}" ;
|
||||
FieldType. FieldType ::= Ident ":" Exp ;
|
||||
separator FieldType ";" ;
|
||||
|
||||
ERec. Exp13 ::= "rec" "{" [FieldValue] "}" ;
|
||||
FieldValue.FieldValue ::= Ident "=" Exp ;
|
||||
separator FieldValue ";" ;
|
||||
|
||||
EEmptyList.Exp13 ::= "[" "]" ;
|
||||
EList. Exp13 ::= "[" [Exp] "]" ;
|
||||
|
||||
-- n-tuple, where n>=2
|
||||
ETuple. Exp13 ::= "(" Exp "," [Exp] ")" ;
|
||||
|
||||
EVar. Exp13 ::= Ident ;
|
||||
EType. Exp13 ::= "Type" ;
|
||||
EStr. Exp13 ::= String ;
|
||||
EInteger. Exp13 ::= Integer ;
|
||||
EDouble. Exp13 ::= Double ;
|
||||
EMeta. Exp13 ::= "?" ;
|
||||
|
||||
coercions Exp 13 ;
|
||||
|
||||
separator nonempty Exp "," ;
|
||||
58
src-3.0/Transfer/Syntax/Test.hs
Normal file
58
src-3.0/Transfer/Syntax/Test.hs
Normal file
@@ -0,0 +1,58 @@
|
||||
-- automatically generated by BNF Converter
|
||||
module Main where
|
||||
|
||||
|
||||
import IO ( stdin, hGetContents )
|
||||
import System ( getArgs, getProgName )
|
||||
|
||||
import Transfer.Syntax.Lex
|
||||
import Transfer.Syntax.Par
|
||||
import Transfer.Syntax.Skel
|
||||
import Transfer.Syntax.Print
|
||||
import Transfer.Syntax.Abs
|
||||
import Transfer.Syntax.Layout
|
||||
|
||||
|
||||
|
||||
import Transfer.ErrM
|
||||
|
||||
type ParseFun a = [Token] -> Err a
|
||||
|
||||
myLLexer = resolveLayout True . myLexer
|
||||
|
||||
type Verbosity = Int
|
||||
|
||||
putStrV :: Verbosity -> String -> IO ()
|
||||
putStrV v s = if v > 1 then putStrLn s else return ()
|
||||
|
||||
runFile :: (Print a, Show a) => Verbosity -> ParseFun a -> FilePath -> IO ()
|
||||
runFile v p f = putStrLn f >> readFile f >>= run v p
|
||||
|
||||
run :: (Print a, Show a) => Verbosity -> ParseFun a -> String -> IO ()
|
||||
run v p s = let ts = myLLexer s in case p ts of
|
||||
Bad s -> do putStrLn "\nParse Failed...\n"
|
||||
putStrV v "Tokens:"
|
||||
putStrV v $ show ts
|
||||
putStrLn s
|
||||
Ok tree -> do putStrLn "\nParse Successful!"
|
||||
showTree v tree
|
||||
|
||||
|
||||
|
||||
showTree :: (Show a, Print a) => Int -> a -> IO ()
|
||||
showTree v tree
|
||||
= do
|
||||
putStrV v $ "\n[Abstract Syntax]\n\n" ++ show tree
|
||||
putStrV v $ "\n[Linearized tree]\n\n" ++ printTree tree
|
||||
|
||||
main :: IO ()
|
||||
main = do args <- getArgs
|
||||
case args of
|
||||
[] -> hGetContents stdin >>= run 2 pModule
|
||||
"-s":fs -> mapM_ (runFile 0 pModule) fs
|
||||
fs -> mapM_ (runFile 2 pModule) fs
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user