Permalink
Browse files

Merge branch 'feature/syntax' into develop

  • Loading branch information...
2 parents e828a67 + da1bab7 commit e2a66e697776fff9f1d685f88ec43f71d8379b7a @Averethel committed Jan 31, 2013
Showing with 330 additions and 0 deletions.
  1. +13 −0 Syntax.hs
  2. +32 −0 Syntax/BinaryPrim.hs
  3. +18 −0 Syntax/Constant.hs
  4. +99 −0 Syntax/Expr.hs
  5. +39 −0 Syntax/Pattern.hs
  6. +18 −0 Syntax/UnaryPrim.hs
  7. +4 −0 Types.hs
  8. +39 −0 Types/Base.hs
  9. +68 −0 Utils/Iseq.hs
View
@@ -0,0 +1,13 @@
+module Syntax (
+ Constant(..),
+ UnaryPrim(..),
+ BinaryPrim(..),
+ Pattern(..),
+ FunClause(..),
+ Expr(..)
+) where
+ import Syntax.Constant
+ import Syntax.UnaryPrim
+ import Syntax.BinaryPrim
+ import Syntax.Pattern
+ import Syntax.Expr
View
@@ -0,0 +1,32 @@
+module Syntax.BinaryPrim where
+ import Utils.Iseq
+
+ data BinaryPrim =
+ BPeq
+ | BPlt
+ | BPgt
+ | BPor
+ | BPand
+ | BPadd
+ | BPsub
+ | BPmult
+ | BPdiv
+ | BPmod
+ | BPassign
+ deriving Eq
+
+ pprBinaryPrim :: BinaryPrim -> Iseq
+ pprBinaryPrim BPeq = iStr "=="
+ pprBinaryPrim BPlt = iStr "<"
+ pprBinaryPrim BPgt = iStr ">"
+ pprBinaryPrim BPor = iStr "or"
+ pprBinaryPrim BPand = iStr "and"
+ pprBinaryPrim BPadd = iStr "+"
+ pprBinaryPrim BPsub = iStr "-"
+ pprBinaryPrim BPmult = iStr "*"
+ pprBinaryPrim BPdiv = iStr "/"
+ pprBinaryPrim BPmod = iStr "%"
+ pprBinaryPrim BPassign = iStr ":="
+
+ instance Show BinaryPrim where
+ show = show . pprBinaryPrim
View
@@ -0,0 +1,18 @@
+module Syntax.Constant where
+ import Utils.Iseq
+
+ data Constant =
+ Cint Integer
+ | Cbool Bool
+ | Cnil
+ | Cunit
+ deriving Eq
+
+ pprConstant :: Constant -> Iseq
+ pprConstant (Cint n) = iStr . show $ n
+ pprConstant (Cbool b) = iStr . show $ b
+ pprConstant Cnil = iStr "[]"
+ pprConstant Cunit = iStr "()"
+
+ instance Show Constant where
+ show n = show . pprConstant $ n
View
@@ -0,0 +1,99 @@
+module Syntax.Expr (
+ FunClause(..),
+ pprFunClause,
+ Expr(..),
+ isAtomicExpr,
+ pprAExpr,
+ pprExpr
+) where
+ import Syntax.BinaryPrim
+ import Syntax.Constant
+ import Syntax.Pattern
+ import Syntax.UnaryPrim
+
+ import Utils.Iseq
+
+ data FunClause = FC {
+ arguments :: [Pattern],
+ body :: Expr
+ } deriving Eq
+
+ pprFunArgs :: [Pattern] -> Iseq
+ pprFunArgs = iInterleave (iStr " ") . map pprAPattern
+
+ pprFunClause :: FunClause -> Iseq
+ pprFunClause fc = pprFunArgs (arguments fc) `iAppend` iStr " -> "
+ `iAppend` pprExpr (body fc)
+
+ pprFunClauses :: [FunClause] -> Iseq
+ pprFunClauses = iInterleave (iConcat [ iNewline, iStr "| "]) .
+ map pprFunClause
+
+ instance Show FunClause where
+ show = show . pprFunClause
+
+ data Expr =
+ Econst Constant
+ | Euprim UnaryPrim
+ | Ebprim BinaryPrim
+ | Evar String
+ | Efun [FunClause]
+ | Elet Pattern Expr Expr
+ | Eletrec String [FunClause] Expr
+ | Eapply Expr [Expr]
+ | Etuple [Expr]
+ | Econs Expr Expr
+ | Eif Expr Expr Expr
+ | Eseq Expr Expr
+ deriving Eq
+
+ isAtomicExpr :: Expr -> Bool
+ isAtomicExpr (Evar _) = True
+ isAtomicExpr (Econst _) = True
+ isAtomicExpr (Euprim _) = True
+ isAtomicExpr (Ebprim _) = True
+ isAtomicExpr _ = False
+
+ pprAExpr :: Expr -> Iseq
+ pprAExpr e
+ | isAtomicExpr e = pprExpr e
+ | otherwise = iStr "(" `iAppend` pprExpr e `iAppend` iStr ")"
+
+ pprArgs :: [Expr] -> Iseq
+ pprArgs = iConcat . map pprAExpr
+
+ pprApplication :: Expr -> [Expr] -> Iseq
+ pprApplication (Ebprim p) [e1, e2] = iConcat [ pprAExpr e1, iStr " ",
+ pprBinaryPrim p, iStr " ",
+ pprAExpr e2 ]
+ pprApplication e args = iConcat [ pprExpr e, pprArgs args ]
+
+ pprExpr :: Expr -> Iseq
+ pprExpr (Econst c) = pprConstant c
+ pprExpr (Euprim p) = pprUnaryPrim p
+ pprExpr (Ebprim p) = pprBinaryPrim p
+ pprExpr (Evar i) = iStr i
+ pprExpr (Efun fcs) = iConcat [ iStr "function {", iNewline, indentation,
+ iIndent $ iStr " " `iAppend`
+ pprFunClauses fcs, iNewline, iStr "}"]
+ pprExpr (Elet p e1 e2) = iConcat [ iStr "let ", pprAPattern p, iStr " = ",
+ pprExpr e1, iStr " in ", pprExpr e2 ]
+ pprExpr (Eletrec i fcs e) = iConcat [ iStr "letrec ", iStr i, iStr " = ",
+ pprExpr (Efun fcs), iStr " in",
+ iNewline, pprExpr e ]
+ pprExpr (Eapply e args) = pprApplication e args
+ pprExpr (Etuple es) = iConcat [ iStr "(", iInterleave (iStr ", ") $
+ map pprAExpr es, iStr ")" ]
+ pprExpr (Econs e1 e2) = pprAExpr e1 `iAppend` iStr " :: "
+ `iAppend` pprAExpr e2
+ pprExpr (Eif e1 e2 e3) = iConcat [ iStr "if ( ", pprExpr e1,
+ iStr ") then {", iNewline, indentation,
+ iIndent $ pprExpr e2, iNewline,
+ iStr "} else {", iNewline, indentation,
+ iIndent $ pprExpr e3, iNewline,
+ iStr "}" ]
+ pprExpr (Eseq e1 e2) = pprAExpr e1 `iAppend` iStr "; "
+ `iAppend` pprAExpr e2
+
+ instance Show Expr where
+ show = show . pprExpr
View
@@ -0,0 +1,39 @@
+module Syntax.Pattern where
+ import Syntax.Constant
+
+ import Utils.Iseq
+
+ data Pattern =
+ Pwildcard
+ | Pval String
+ | Pconst Constant
+ | Ptuple [Pattern]
+ | Pcons Pattern Pattern
+ deriving Eq
+
+ isAtomicPattern :: Pattern -> Bool
+ isAtomicPattern Pwildcard = True
+ isAtomicPattern (Pval _) = True
+ isAtomicPattern (Pconst _) = True
+ isAtomicPattern _ = False
+
+ pprAPattern :: Pattern -> Iseq
+ pprAPattern p
+ | isAtomicPattern p = pprPattern p
+ | otherwise = iStr "(" `iAppend` pprPattern p `iAppend` iStr ")"
+
+ pprPattern :: Pattern -> Iseq
+ pprPattern Pwildcard =
+ iStr "_"
+ pprPattern (Pval v) =
+ iStr v
+ pprPattern (Pconst c) =
+ pprConstant c
+ pprPattern (Ptuple ps) =
+ iConcat [ iStr "(", iInterleave (iStr ", ") $
+ map pprAPattern ps, iStr ")" ]
+ pprPattern (Pcons p1 p2) =
+ pprAPattern p1 `iAppend` iStr " :: " `iAppend` pprAPattern p2
+
+ instance Show Pattern where
+ show = show . pprPattern
View
@@ -0,0 +1,18 @@
+module Syntax.UnaryPrim where
+ import Utils.Iseq
+
+ data UnaryPrim =
+ UPnot
+ | UPref
+ | UPderef
+ | UPminus
+ deriving Eq
+
+ pprUnaryPrim :: UnaryPrim -> Iseq
+ pprUnaryPrim UPnot = iStr "not"
+ pprUnaryPrim UPref = iStr "!"
+ pprUnaryPrim UPderef = iStr "&"
+ pprUnaryPrim UPminus = iStr "-"
+
+ instance Show UnaryPrim where
+ show = show . pprUnaryPrim
View
@@ -0,0 +1,4 @@
+module Types (
+ Type(..)
+) where
+ import Types.Base
View
@@ -0,0 +1,39 @@
+module Types.Base where
+ import Utils.Iseq
+
+ data Type =
+ Tint
+ | Tbool
+ | Tunit
+ | Tvar String
+ | Tlist Type
+ | Tref Type
+ | Ttuple [Type]
+ | Tfun [Type] Type
+ deriving Eq
+
+ isAtomicType :: Type -> Bool
+ isAtomicType (Tfun _ _) = False
+ isAtomicType (Tlist _) = False
+ isAtomicType (Tref _) = False
+ isAtomicType _ = True
+
+ pprAType :: Type -> Iseq
+ pprAType t
+ | isAtomicType t = pprType t
+ | otherwise = iStr "(" `iAppend` pprType t `iAppend` iStr ")"
+
+ pprType :: Type -> Iseq
+ pprType Tint = iStr "int"
+ pprType Tbool = iStr "bool"
+ pprType Tunit = iStr "unit"
+ pprType (Tvar v) = iStr v
+ pprType (Tlist t) = pprAType t `iAppend` iStr " list"
+ pprType (Tref t) = pprType t `iAppend` iStr " ref"
+ pprType (Ttuple ts) = iConcat [ iStr "(", iInterleave (iStr ", ") $
+ map pprAType ts, iStr ")" ]
+ pprType (Tfun ts t) = iConcat [ iInterleave (iStr " -> ") $ map pprAType ts,
+ iStr " -> ", pprType t ]
+
+ instance Show Type where
+ show = show . pprType
View
@@ -0,0 +1,68 @@
+module Utils.Iseq (
+ Iseq,
+ iNil,
+ iStr,
+ iAppend,
+ iNewline,
+ iIndent,
+ iConcat,
+ iInterleave,
+ indentation ) where
+
+ data Iseq =
+ INil
+ | INewline
+ | IStr String
+ | IIndent Iseq
+ | IAppend Iseq Iseq
+
+ iNil :: Iseq
+ iNil = INil
+
+ iStr :: String -> Iseq
+ iStr s = case lines s of
+ [l] -> IStr l
+ ls -> iInterleave iNewline $ map IStr ls
+
+ iAppend :: Iseq -> Iseq -> Iseq
+ iAppend = IAppend
+
+ iNewline :: Iseq
+ iNewline = INewline
+
+ iIndent :: Iseq -> Iseq
+ iIndent = IIndent
+
+ iConcat :: [Iseq] -> Iseq
+ iConcat = foldr iAppend iNil
+
+ iInterleave :: Iseq -> [Iseq] -> Iseq
+ iInterleave _ [] = iNil
+ iInterleave _ [s] = s
+ iInterleave sep (s:ss) = s `iAppend` sep `iAppend` iInterleave sep ss
+
+ spaces :: Int -> String
+ spaces n = replicate n ' '
+
+ flatten :: Int -> [(Iseq, Int)] -> String
+ flatten _ [] =
+ ""
+ flatten col ((INil, _ ) : seqs) =
+ flatten col seqs
+ flatten _ ((INewline, indent) : seqs) =
+ '\n':spaces indent ++ flatten indent seqs
+ flatten col ((IStr s, _ ) : seqs) =
+ s ++ flatten (col + length s) seqs
+ flatten col ((IIndent s, _ ) : seqs) =
+ flatten col ((s, col) : seqs)
+ flatten col ((IAppend s1 s2, indent) : seqs) =
+ flatten col ((s1, indent):(s2, indent):seqs)
+
+ iDisplay :: Iseq -> String
+ iDisplay iseq = flatten 0 [(iseq, 0)]
+
+ instance Show Iseq where
+ show = iDisplay
+
+ indentation :: Iseq
+ indentation = iStr " "

0 comments on commit e2a66e6

Please sign in to comment.