on master help sign in
Begin migrating the AST to its own branch for the source syntax of the language.
bbb2b2aevancz
compiler/SourceSyntax/Declaration.hsnew file+15
@@ -0,0 +1,15 @@
1+{-# LANGUAGE DeriveDataTypeable #-}
2+module SourceSyntax.Declaration where
3+
4+import Data.Data
5+import qualified SourceSyntax.Expression as Expr
6+import Types.Types
7+
8+data Declaration
9+ = Definition Expr.Def
10+ | Datatype String [X] [(String,[Type])]
11+ | TypeAlias String [X] Type
12+ | ImportEvent String Expr.LExpr String Type
13+ | ExportEvent String String Type
14+ | Fixity Int String
15+ deriving (Eq, Show, Data, Typeable)
compiler/SourceSyntax/Expression.hsnew file+101
@@ -0,0 +1,101 @@
1+{-# LANGUAGE DeriveDataTypeable #-}
2+module SourceSyntax.Expression where
3+
4+import Data.Data
5+import Data.List (intercalate)
6+import qualified Text.Pandoc as Pandoc
7+import qualified SourceSyntax.Helpers as Help
8+import qualified SourceSyntax.Location as Location
9+import qualified SourceSyntax.Pattern as Pattern
10+import qualified SourceSyntax.Literal as Literal
11+import Types.Types
12+
13+type LExpr = Location.Located Expr
14+data Expr = Literal Literal.Literal
15+ | Range LExpr LExpr
16+ | Access LExpr String
17+ | Remove LExpr String
18+ | Insert LExpr String LExpr
19+ | Modify LExpr [(String,LExpr)]
20+ | Record [(String,[String],LExpr)]
21+ | Binop String LExpr LExpr
22+ | Lambda String LExpr
23+ | App LExpr LExpr
24+ | MultiIf [(LExpr,LExpr)]
25+ | Let [Def] LExpr
26+ | Var String
27+ | Case LExpr [(Pattern.Pattern,LExpr)]
28+ | Data String [LExpr]
29+ | Markdown Pandoc.Pandoc
30+ deriving (Eq, Data, Typeable)
31+
32+data Def = FnDef String [String] LExpr
33+ | OpDef String String String LExpr
34+ | TypeAnnotation String Type
35+ deriving (Eq, Data, Typeable)
36+
37+cons h t = Location.merge h t (Data "Cons" [h,t])
38+nil = Location.L (Just "[]") Location.NoSpan (Data "Nil" [])
39+list = foldr cons nil
40+tuple es = Data ("Tuple" ++ show (length es)) es
41+
42+delist (Location.L _ _ (Data "Cons" [h,t])) = h : delist t
43+delist _ = []
44+
45+
46+instance Show Expr where
47+ show e =
48+ let show' (Location.L _ _ e) = Help.parensIf (needsParens e) (show e) in
49+ case e of
50+ Literal lit -> show lit
51+ Range e1 e2 -> "[" ++ show e1 ++ ".." ++ show e2 ++ "]"
52+ Access e x -> show' e ++ "." ++ x
53+ Remove e x -> Help.brkt (show e ++ " - " ++ x)
54+ Insert (Location.L _ _ (Remove e y)) x v ->
55+ Help.brkt (show e ++ " - " ++ y ++ " | " ++ x ++ " = " ++ show v)
56+ Insert e x v -> Help.brkt (show e ++ " | " ++ x ++ " = " ++ show v)
57+ Modify e fs -> Help.brkt (show e ++" | "++ intercalate ", " (map field fs))
58+ where field (x,e) = x ++ " <- " ++ show e
59+ Record r -> Help.brkt (intercalate ", " (map fields r))
60+ where fields (f,args,e) = f ++ concatMap (' ':) args ++ " = " ++ show e
61+ Binop op e1 e2 -> show' e1 ++ " " ++ op ++ " " ++ show' e2
62+ Lambda x e -> let (xs,e') = getLambdas (Location.none $ Lambda x e) in
63+ concat [ "\\", intercalate " " xs, " -> ", show e' ]
64+ App e1 e2 -> show' e1 ++ " " ++ show' e2
65+ MultiIf (p:ps) -> concat [ "if | ", iff p, sep (map iff ps) ]
66+ where iff (b,e) = show b ++ " -> " ++ show e
67+ sep = concatMap ("\n | " ++)
68+ Let defs e -> "let { "++intercalate " ; " (map show defs)++" } in "++show e
69+ Var (c:cs) -> if Help.isOp c then Help.parens (c:cs) else c:cs
70+ Case e pats -> "case "++ show e ++" of " ++ Help.brkt (intercalate " ; " pats')
71+ where pats' = map (\(p,e) -> show p ++ " -> " ++ show e) pats
72+ Data name es
73+ | name == "Cons" -> ("["++) . (++"]") . intercalate "," . map show $
74+ delist (Location.none $ Data "Cons" es)
75+ | name == "Nil" -> "[]"
76+ | otherwise -> name ++ " " ++ intercalate " " (map show' es)
77+ Markdown _ -> "[markdown| ... |]"
78+
79+
80+instance Show Def where
81+ show e =
82+ case e of
83+ FnDef v [] e -> v ++ " = " ++ show e
84+ FnDef f args e -> f ++ concatMap (' ':) args ++ " = " ++ show e
85+ OpDef op a1 a2 e -> intercalate " " [a1,op,a2] ++ " = " ++ show e
86+ TypeAnnotation n t -> n ++ " : " ++ show t
87+
88+getLambdas (Location.L _ _ (Lambda x e)) = (x:xs,e')
89+ where (xs,e') = getLambdas e
90+getLambdas e = ([],e)
91+
92+needsParens e =
93+ case e of
94+ Binop _ _ _ -> True
95+ Lambda _ _ -> True
96+ App _ _ -> True
97+ MultiIf _ -> True
98+ Let _ _ -> True
99+ Case _ _ -> True
100+ Data name (x:xs) -> name /= "Cons"
101+ _ -> False
compiler/SourceSyntax/Helpers.hsnew file+11
@@ -0,0 +1,11 @@
1+
2+module SourceSyntax.Helpers where
3+
4+import Data.Char (isSymbol)
5+
6+brkt s = "{ " ++ s ++ " }"
7+
8+parens s = "(" ++ s ++ ")"
9+parensIf b s = if b then parens s else s
10+
11+isOp c = isSymbol c || elem c "+-/*=.$<>:&|^?%#@~!"
compiler/SourceSyntax/Literal.hsnew file+21
@@ -0,0 +1,21 @@
1+{-# LANGUAGE DeriveDataTypeable #-}
2+module SourceSyntax.Literal where
3+
4+import Data.Data
5+
6+data Literal = IntNum Int
7+ | FloatNum Float
8+ | Chr Char
9+ | Str String
10+ | Boolean Bool
11+ deriving (Eq, Data, Typeable)
12+
13+
14+instance Show Literal where
15+ show e =
16+ case e of
17+ IntNum n -> show n
18+ FloatNum n -> show n
19+ Chr c -> show c
20+ Str s -> show s
21+ Boolean b -> show b
compiler/Model/Located.hs → compiler/SourceSyntax/Location.hsrenamed+8−8
@@ -1,5 +1,5 @@
1{-# LANGUAGE DeriveDataTypeable #-}
1{-# LANGUAGE DeriveDataTypeable #-}
2−module Located where
2+module SourceSyntax.Location where
3
3
4import Text.Parsec.Pos
4import Text.Parsec.Pos
5import Data.Data
5import Data.Data
@@ -27,17 +27,17 @@ instance Show e => Show (Located e) where
27
27
28
28
29
29
30−notLocated = L Nothing NoSpan
30+none = L Nothing NoSpan
31
31
32−pos start end = L Nothing
32+at start end = L Nothing
33− (Span (Pos (sourceLine start) (sourceColumn start))
33+ (Span (Pos (sourceLine start) (sourceColumn start))
34− (Pos (sourceLine end ) (sourceColumn end )))
34+ (Pos (sourceLine end ) (sourceColumn end )))
35
35
36−epos (L _ s1 _) (L _ s2 _) = L Nothing span
36+merge (L _ s1 _) (L _ s2 _) = L Nothing span
37 where span = case (s1,s2) of
37 where span = case (s1,s2) of
38 (Span start _, Span _ end) -> Span start end
38 (Span start _, Span _ end) -> Span start end
39 (_, NoSpan) -> s1
39 (_, NoSpan) -> s1
40 (NoSpan, _) -> s2
40 (NoSpan, _) -> s2
41
41
42−addLoc x (L Nothing span e) = L (Just (show x)) span e
42+add x (L Nothing span e) = L (Just (show x)) span e
43−addLoc x (L txt span e) = L txt span e
43+add x (L txt span e) = L txt span e
compiler/SourceSyntax/Module.hsnew file+23
@@ -0,0 +1,23 @@
1+{-# LANGUAGE DeriveDataTypeable #-}
2+module SourceSyntax.Module where
3+
4+import Data.Data
5+import Data.List (intercalate)
6+import qualified SourceSyntax.Declaration as Decl
7+import System.FilePath (joinPath)
8+import Types.Types
9+
10+data Module = Module [String] Exports Imports [Decl.Declaration]
11+ deriving (Show)
12+
13+type Exports = [String]
14+
15+type Imports = [(String, ImportMethod)]
16+data ImportMethod = As String | Importing [String] | Hiding [String]
17+ deriving (Eq, Ord, Show, Data, Typeable)
18+
19+name :: Module -> String
20+name (Module names _ _ _) = intercalate "." names
21+
22+path :: Module -> FilePath
23+path (Module names _ _ _) = joinPath names
compiler/SourceSyntax/Pattern.hsnew file+39
@@ -0,0 +1,39 @@
1+{-# LANGUAGE DeriveDataTypeable #-}
2+module SourceSyntax.Pattern where
3+
4+import Data.Char (isDigit)
5+import Data.List (intercalate)
6+import Data.Data
7+import SourceSyntax.Helpers
8+import qualified SourceSyntax.Literal as Literal
9+
10+data Pattern = PData String [Pattern]
11+ | PRecord [String]
12+ | PAlias String Pattern
13+ | PVar String
14+ | PAnything
15+ | PLiteral Literal.Literal
16+ deriving (Eq, Data, Typeable)
17+
18+cons h t = PData "Cons" [h,t]
19+nil = PData "Nil" []
20+list = foldr cons nil
21+tuple es = PData ("Tuple" ++ show (length es)) es
22+
23+
24+instance Show Pattern where
25+ show p =
26+ case p of
27+ PVar x -> x
28+ PLiteral lit -> show lit
29+ PRecord fs -> brkt (intercalate ", " fs)
30+ PAlias x p -> show p ++ " as " ++ x
31+ PAnything -> "_"
32+ PData "Cons" [hd@(PData "Cons" _),tl] ->
33+ parens (show hd) ++ " :: " ++ show tl
34+ PData "Cons" [hd,tl] -> show hd ++ " :: " ++ show tl
35+ PData "Nil" [] -> "[]"
36+ PData name ps ->
37+ if take 5 name == "Tuple" && all isDigit (drop 5 name) then
38+ parens . intercalate ", " $ map show ps
39+ else parensIf (not (null ps)) $ unwords (name : map show ps)