mirror of
https://github.com/rgleichman/glance.git
synced 2024-09-11 15:05:41 +03:00
Add in-progress SimplifySyntax.hs.
This commit is contained in:
parent
ddd8475d5e
commit
29f03483f7
62
app/SimplifySyntax.hs
Normal file
62
app/SimplifySyntax.hs
Normal file
@ -0,0 +1,62 @@
|
|||||||
|
module SimplifySyntax where
|
||||||
|
|
||||||
|
import qualified Language.Haskell.Exts as Exts
|
||||||
|
|
||||||
|
import Translate(qOpToExp)
|
||||||
|
-- A simplified Haskell syntax tree
|
||||||
|
|
||||||
|
-- rhs is now SimpExp
|
||||||
|
|
||||||
|
-- A simplified Haskell expression.
|
||||||
|
data SimpExp l =
|
||||||
|
SeName l (Exts.QName l)
|
||||||
|
| SeLit l (Exts.Literal l)
|
||||||
|
| SeApp l
|
||||||
|
(SimpExp l) -- function
|
||||||
|
(SimpExp l) -- argument
|
||||||
|
| SeLambda l [SimpPat l] (SimpExp l)
|
||||||
|
| SeLet l [SimpDecl l] (SimpExp l)
|
||||||
|
| SeCase l (SimpExp l) [SimpAlt l]
|
||||||
|
| SeGuard l [SelectorAndVal l]
|
||||||
|
|
||||||
|
|
||||||
|
data SelectorAndVal l = SelectorAndVal {
|
||||||
|
svSelector :: SimpExp l
|
||||||
|
, svVal :: SimpExp l
|
||||||
|
}
|
||||||
|
|
||||||
|
data SimpAlt l = SimpAlt {
|
||||||
|
saPat :: SimpPat l
|
||||||
|
, saVal :: SimpExp l
|
||||||
|
}
|
||||||
|
|
||||||
|
data SimpDecl l =
|
||||||
|
-- These don't have decl lists, since only lets have decl lists
|
||||||
|
SdFunBind l (Exts.Name l) [SimpPat l] (SimpExp l)
|
||||||
|
| SdPatBind l (SimpPat l) (SimpExp l)
|
||||||
|
|
||||||
|
data SimpPat l =
|
||||||
|
SpVar l (Exts.Name l)
|
||||||
|
| SpLit l (Exts.Sign l) (Exts.Literal l)
|
||||||
|
| SpApp l (Exts.QName l) [SimpPat l]
|
||||||
|
| SpAsPat l (Exts.Name l) (SimpPat l)
|
||||||
|
|
||||||
|
infixAppToSeApp :: a -> Exts.Exp a -> Exts.QOp a -> Exts.Exp a -> SimpExp a
|
||||||
|
infixAppToSeApp l e1 op e2 = case op of
|
||||||
|
Exts.QVarOp _ (Exts.UnQual _ (Exts.Symbol _ sym)) -> case sym of
|
||||||
|
"$" -> hsExpToSimpExp (Exts.App l e1 e2)
|
||||||
|
-- TODO
|
||||||
|
-- "." -> grNamePortToGrRef
|
||||||
|
-- <$> evalFunctionComposition c (e1 : compositionToList e2)
|
||||||
|
_ -> defaultCase
|
||||||
|
_ -> defaultCase
|
||||||
|
where
|
||||||
|
defaultCase = hsExpToSimpExp $ Exts.App l (Exts.App l (qOpToExp op) e1) e2
|
||||||
|
|
||||||
|
hsExpToSimpExp :: Exts.Exp a -> SimpExp a
|
||||||
|
hsExpToSimpExp e = case e of
|
||||||
|
Exts.Var l n -> SeName l n
|
||||||
|
Exts.Con l n -> SeName l n
|
||||||
|
Exts.Lit l n -> SeLit l n
|
||||||
|
Exts.InfixApp l e1 op e2 -> infixAppToSeApp l e1 op e2
|
||||||
|
Exts.App l f arg -> SeApp l (hsExpToSimpExp f) (hsExpToSimpExp arg)
|
@ -2,7 +2,8 @@
|
|||||||
module Translate(
|
module Translate(
|
||||||
translateStringToSyntaxGraph,
|
translateStringToSyntaxGraph,
|
||||||
translateStringToCollapsedGraphAndDecl,
|
translateStringToCollapsedGraphAndDecl,
|
||||||
translateModuleToCollapsedGraphs
|
translateModuleToCollapsedGraphs,
|
||||||
|
qOpToExp
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Diagrams.Prelude((<>))
|
import Diagrams.Prelude((<>))
|
||||||
|
Loading…
Reference in New Issue
Block a user