git.iko.soy/elk
on master help sign in
Rename port keyword to input/output
5e77639Evan Czaplicki
src/AST/Declaration.hs+26−18
compare with master
unifiedsplit
@@ -11,7 +11,6 @@ import AST.PrettyPrint
11import Text.PrettyPrint as P
11import Text.PrettyPrint as P
12
12
13
13
14−
15data Declaration' port def var
14data Declaration' port def var
16 = Definition def
15 = Definition def
17 | Datatype String [String] [(String, [T.Type var])]
16 | Datatype String [String] [(String, [T.Type var])]
@@ -25,8 +24,9 @@ data Assoc = L | N | R
25
24
26
25
27data RawPort
26data RawPort
28− = PPAnnotation String T.RawType
27+ = InputAnnotation String T.RawType
28+ | OutputAnnotation String T.RawType
29− | PPDef String Source.Expr
29+ | OutputDef String Source.Expr
30
30
31
31
32data Port expr var
32data Port expr var
@@ -34,11 +34,16 @@ data Port expr var
34 | In String (T.Type var)
34 | In String (T.Type var)
35
35
36
36
37+type SourceDecl =
37−type SourceDecl = Declaration' RawPort Source.Def Var.Raw
38+ Declaration' RawPort Source.Def Var.Raw
39+
40+
41+type ValidDecl =
38−type ValidDecl = Declaration' (Port Valid.Expr Var.Raw) Valid.Def Var.Raw
42+ Declaration' (Port Valid.Expr Var.Raw) Valid.Def Var.Raw
43+
44+
45+type CanonicalDecl =
39−type CanonicalDecl = Declaration' (Port Canonical.Expr Var.Canonical)
46+ Declaration' (Port Canonical.Expr Var.Canonical) Canonical.Def Var.Canonical
40− Canonical.Def
41− Var.Canonical
42
47
43
48
44portName :: Port expr var -> String
49portName :: Port expr var -> String
@@ -119,26 +124,29 @@ instance (Pretty port, Pretty def, Pretty var, Var.ToString var) =>
119instance Pretty RawPort where
124instance Pretty RawPort where
120 pretty port =
125 pretty port =
121 case port of
126 case port of
122− PPAnnotation name tipe ->
127+ InputAnnotation name tipe ->
123− prettyPort name ":" tipe
128+ prettyPort "input" name ":" tipe
129+
130+ OutputAnnotation name tipe ->
131+ prettyPort "output" name ":" tipe
124
132
125− PPDef name expr ->
133+ OutputDef name expr ->
126− prettyPort name "=" expr
134+ prettyPort "output" name "=" expr
127
135
128
136
129instance (Pretty expr, Pretty var, Var.ToString var) => Pretty (Port expr var) where
137instance (Pretty expr, Pretty var, Var.ToString var) => Pretty (Port expr var) where
130 pretty port =
138 pretty port =
131 case port of
139 case port of
132 In name tipe ->
140 In name tipe ->
133− prettyPort name ":" tipe
141+ prettyPort "input" name ":" tipe
134
142
135 Out name expr tipe ->
143 Out name expr tipe ->
136 P.vcat
144 P.vcat
137− [ prettyPort name ":" tipe
145+ [ prettyPort "output" name ":" tipe
138− , prettyPort name "=" expr
146+ , prettyPort "output" name "=" expr
139 ]
147 ]
140
148
141
149
142−prettyPort :: (Pretty a) => String -> String -> a -> Doc
150+prettyPort :: (Pretty a) => String -> String -> String -> a -> Doc
143−prettyPort name op e =
151+prettyPort keyword name op e =
144− P.text "port" <+> P.text name <+> P.text op <+> pretty e
152+ P.text keyword <+> P.text name <+> P.text op <+> pretty e
src/Parse/Declaration.hs+30−14
@@ -12,7 +12,7 @@ import qualified Parse.Type as Type
12
12
13declaration :: IParser D.SourceDecl
13declaration :: IParser D.SourceDecl
14declaration =
14declaration =
15− typeDecl <|> infixDecl <|> port <|> definition
15+ typeDecl <|> infixDecl <|> input <|> output <|> definition
16
16
17
17
18definition :: IParser D.SourceDecl
18definition :: IParser D.SourceDecl
@@ -53,19 +53,35 @@ infixDecl = do
53 D.Fixity assoc (read [n]) <$> anyOp
53 D.Fixity assoc (read [n]) <$> anyOp
54
54
55
55
56−port :: IParser D.SourceDecl
56+input :: IParser D.SourceDecl
57−port =
57+input =
58− do try (reserved "port")
58+ do try (reserved "input")
59 whitespace
59 whitespace
60 name <- lowVar
60 name <- lowVar
61 whitespace
61 whitespace
62− let port' op ctor expr =
62+ ioEnding D.InputAnnotation name hasType Type.expr
63− do try op
63+
64+
65+output :: IParser D.SourceDecl
66+output =
67+ do try (reserved "output")
64− whitespace
68+ whitespace
65− ctor name <$> expr
69+ name <- lowVar
66−
70+ whitespace
67− D.Port <$>
68− choice
71+ choice
69− [ port' hasType D.PPAnnotation Type.expr
72+ [ ioEnding D.OutputAnnotation name hasType Type.expr
70− , port' equals D.PPDef Expr.expr
73+ , ioEnding D.OutputDef name equals Expr.expr
71− ]
74+ ]
75+
76+
77+ioEnding
78+ :: (String -> a -> D.RawPort)
79+ -> String
80+ -> IParser String
81+ -> IParser a
82+ -> IParser D.SourceDecl
83+ioEnding decl name op valueParser =
84+ do op
85+ whitespace
86+ value <- valueParser
87+ return (D.Port (decl name value))
src/Parse/Helpers.hs+2−1
@@ -31,7 +31,8 @@ reserveds =
31 , "module", "where"
31 , "module", "where"
32 , "import", "as", "hiding", "open"
32 , "import", "as", "hiding", "open"
33 , "export", "foreign"
33 , "export", "foreign"
34− , "deriving", "port"
34+ , "deriving"
35+ , "input", "output"
35 ]
36 ]
36
37
37
38
src/Transform/Declaration.hs+82−62
@@ -19,74 +19,86 @@ import qualified Transform.Definition as Def
19
19
20
20
21combineAnnotations :: [D.SourceDecl] -> Either String [D.ValidDecl]
21combineAnnotations :: [D.SourceDecl] -> Either String [D.ValidDecl]
22−combineAnnotations = go
22+combineAnnotations =
23+ go
23− where
24+ where
24− msg x = "Syntax Error: The type annotation for '" ++ x ++
25+ msg x = "Syntax Error: The type annotation for '" ++ x ++
25− "' must be directly above its definition."
26+ "' must be directly above its definition."
26−
27+
27− exprCombineAnnotations = Expr.crawlLet Def.combineAnnotations
28+ exprCombineAnnotations = Expr.crawlLet Def.combineAnnotations
28−
29+
29− go decls =
30+ go decls =
30− case decls of
31+ case decls of
31− -- simple cases, pass them through with no changes
32+ -- simple cases, pass them through with no changes
32− [] -> return []
33+ [] -> return []
33−
34+
34− D.Datatype name tvars ctors : rest ->
35+ D.Datatype name tvars ctors : rest ->
35− (:) (D.Datatype name tvars ctors) <$> go rest
36+ (:) (D.Datatype name tvars ctors) <$> go rest
36−
37+
37− D.TypeAlias name tvars alias : rest ->
38+ D.TypeAlias name tvars alias : rest ->
38− (:) (D.TypeAlias name tvars alias) <$> go rest
39+ (:) (D.TypeAlias name tvars alias) <$> go rest
39−
40+
40− D.Fixity assoc prec op : rest ->
41+ D.Fixity assoc prec op : rest ->
41− (:) (D.Fixity assoc prec op) <$> go rest
42+ (:) (D.Fixity assoc prec op) <$> go rest
42−
43+
43− -- combine definitions
44+ -- combine definitions
44− D.Definition def : defRest ->
45+ D.Definition def : defRest ->
45− case def of
46+ case def of
46− Source.Definition pat expr ->
47+ Source.Definition pat expr ->
47− do expr' <- exprCombineAnnotations expr
48+ do expr' <- exprCombineAnnotations expr
48− let def' = Valid.Definition pat expr' Nothing
49+ let def' = Valid.Definition pat expr' Nothing
49− (:) (D.Definition def') <$> go defRest
50+ (:) (D.Definition def') <$> go defRest
50−
51+
51− Source.TypeAnnotation name tipe ->
52+ Source.TypeAnnotation name tipe ->
52− case defRest of
53+ case defRest of
53− D.Definition (Source.Definition pat@(P.Var name') expr) : rest
54+ D.Definition (Source.Definition pat@(P.Var name') expr) : rest
54− | name == name' ->
55+ | name == name' ->
55− do expr' <- exprCombineAnnotations expr
56+ do expr' <- exprCombineAnnotations expr
56− let def' = Valid.Definition pat expr' (Just tipe)
57+ let def' = Valid.Definition pat expr' (Just tipe)
57− (:) (D.Definition def') <$> go rest
58+ (:) (D.Definition def') <$> go rest
58−
59+
59− _ -> Left (msg name)
60+ _ -> Left (msg name)
60−
61+
61− -- combine ports
62+ -- combine ports
62− D.Port port : portRest ->
63+ D.Port port : portRest ->
63− case port of
64+ case port of
65+ D.InputAnnotation name tipe ->
66+ (:) (D.Port (D.In name tipe)) <$> go portRest
67+
68+ D.OutputDef name _ ->
64− D.PPDef name _ -> Left (msg name)
69+ Left (msg name)
65− D.PPAnnotation name tipe ->
70+
71+ D.OutputAnnotation name tipe ->
66− case portRest of
72+ case portRest of
67− D.Port (D.PPDef name' expr) : rest | name == name' ->
73+ D.Port (D.OutputDef name' expr) : rest | name == name' ->
68− do expr' <- exprCombineAnnotations expr
74+ do expr' <- exprCombineAnnotations expr
69− (:) (D.Port (D.Out name expr' tipe)) <$> go rest
75+ (:) (D.Port (D.Out name expr' tipe)) <$> go rest
70−
76+
71− _ -> (:) (D.Port (D.In name tipe)) <$> go portRest
77+ _ ->
78+ Left (msg name)
72
79
73
80
74toExpr :: Module.Name -> [D.CanonicalDecl] -> [Canonical.Def]
81toExpr :: Module.Name -> [D.CanonicalDecl] -> [Canonical.Def]
82+toExpr moduleName =
75−toExpr moduleName = concatMap (toDefs moduleName)
83+ concatMap (toDefs moduleName)
84+
76
85
77toDefs :: Module.Name -> D.CanonicalDecl -> [Canonical.Def]
86toDefs :: Module.Name -> D.CanonicalDecl -> [Canonical.Def]
78toDefs moduleName decl =
87toDefs moduleName decl =
79 let typeVar = Var.Canonical (Var.Module moduleName) in
88 let typeVar = Var.Canonical (Var.Module moduleName) in
80 case decl of
89 case decl of
81− D.Definition def -> [def]
90+ D.Definition def ->
91+ [def]
82
92
83− D.Datatype name tvars constructors -> concatMap toDefs' constructors
93+ D.Datatype name tvars constructors ->
94+ concatMap toDefs' constructors
84 where
95 where
85 toDefs' (ctor, tipes) =
96 toDefs' (ctor, tipes) =
86 let vars = take (length tipes) arguments
97 let vars = take (length tipes) arguments
87 tbody = T.App (T.Type (typeVar name)) (map T.Var tvars)
98 tbody = T.App (T.Type (typeVar name)) (map T.Var tvars)
88 body = A.none . E.Data ctor $ map (A.none . E.localVar) vars
99 body = A.none . E.Data ctor $ map (A.none . E.localVar) vars
100+ in
89− in [ definition ctor (buildFunction body vars) (foldr T.Lambda tbody tipes) ]
101+ [ definition ctor (buildFunction body vars) (foldr T.Lambda tbody tipes) ]
90
102
91 D.TypeAlias name _ tipe@(T.Record fields ext) ->
103 D.TypeAlias name _ tipe@(T.Record fields ext) ->
92 [ definition name (buildFunction record vars) (foldr T.Lambda result args) ]
104 [ definition name (buildFunction record vars) (foldr T.Lambda result args) ]
@@ -99,13 +111,16 @@ toDefs moduleName decl =
99 vars = take (length args) arguments
111 vars = take (length args) arguments
100
112
101 efields = zip (map fst fields) (map var vars)
113 efields = zip (map fst fields) (map var vars)
114+ record =
102− record = case ext of
115+ case ext of
103− Nothing -> A.none $ E.Record efields
116+ Nothing -> A.none $ E.Record efields
117+ Just _ ->
104− Just _ -> foldl (\r (f,v) -> A.none $ E.Insert r f v) (var $ last vars) efields
118+ foldl (\r (f,v) -> A.none $ E.Insert r f v) (var $ last vars) efields
105
119
106 -- Type aliases must be added to an extended equality dictionary,
120 -- Type aliases must be added to an extended equality dictionary,
107 -- but they do not require any basic constraints.
121 -- but they do not require any basic constraints.
108− D.TypeAlias _ _ _ -> []
122+ D.TypeAlias _ _ _ ->
123+ []
109
124
110 D.Port port ->
125 D.Port port ->
111 case port of
126 case port of
@@ -115,15 +130,20 @@ toDefs moduleName decl =
115 [ definition name (A.none $ E.PortIn name tipe) tipe ]
130 [ definition name (A.none $ E.PortIn name tipe) tipe ]
116
131
117 -- no constraints are needed for fixity declarations
132 -- no constraints are needed for fixity declarations
118− D.Fixity _ _ _ -> []
133+ D.Fixity _ _ _ ->
134+ []
119
135
120
136
121arguments :: [String]
137arguments :: [String]
138+arguments =
122−arguments = map (:[]) ['a'..'z'] ++ map (\n -> "_" ++ show (n :: Int)) [1..]
139+ map (:[]) ['a'..'z'] ++ map (\n -> "_" ++ show (n :: Int)) [1..]
140+
123
141
124buildFunction :: Canonical.Expr -> [String] -> Canonical.Expr
142buildFunction :: Canonical.Expr -> [String] -> Canonical.Expr
125buildFunction body@(A.A s _) vars =
143buildFunction body@(A.A s _) vars =
126− foldr (\p e -> A.A s (E.Lambda p e)) body (map P.Var vars)
144+ foldr (\p e -> A.A s (E.Lambda p e)) body (map P.Var vars)
145+
127
146
128definition :: String -> Canonical.Expr -> T.CanonicalType -> Canonical.Def
147definition :: String -> Canonical.Expr -> T.CanonicalType -> Canonical.Def
148+definition name expr tipe =
129−definition name expr tipe = Canonical.Definition (P.Var name) expr (Just tipe)
149+ Canonical.Definition (P.Var name) expr (Just tipe)