From 817af8de40d49db39dcf02ee5fe346f0d7b73118 Mon Sep 17 00:00:00 2001
From: Mart Lubbers <mart@martlubbers.net>
Date: Fri, 22 Apr 2016 12:08:38 +0200
Subject: [PATCH] HIGHER ORDER FUNCTIONS!!!!!1!11!!1one!1eleven
---
AST.dcl | 7 ++-----
AST.icl | 4 ++--
Makefile | 2 +-
grammar/grammar.txt | 1 +
parse.icl | 14 ++++++++------
sem.icl | 8 +++++---
6 files changed, 19 insertions(+), 17 deletions(-)
diff --git a/AST.dcl b/AST.dcl
index bf6f54f..45eab9e 100644
--- a/AST.dcl
+++ b/AST.dcl
@@ -38,9 +38,6 @@ from StdOverloaded import class toString, class ==
| FunStmt String [Expr]
| ReturnStmt (Maybe Expr)
-instance toString AST
-instance toString Type
instance toString Pos
-instance toString Op2
-instance == Op2
-instance toString FieldSelector
+instance toString Type
+instance toString AST
diff --git a/AST.icl b/AST.icl
index 43c46f7..90d1e53 100644
--- a/AST.icl
+++ b/AST.icl
@@ -63,7 +63,7 @@ instance print Type where
print BoolType = print "Bool"
print CharType = print "Char"
print VoidType = print "Void"
- print (t1 ->> t2) = print t1 ++ [" -> ":print t2]
+ print (t1 ->> t2) = ["(":print t1 ++ [" -> ":print t2]] ++ [")"]
instance print String where
print s = [s]
@@ -75,7 +75,7 @@ instance print FieldSelector where
print FieldFst = print "fst"
instance print VarDef where
- print (VarDef i fs) = printersperse "." [i:flatten $ map print fs]
+ print (VarDef i fs) = printersperse "." [i:printersperse "" fs]
instance toString Op2 where
toString o = case o of
diff --git a/Makefile b/Makefile
index fb45bca..66c5913 100644
--- a/Makefile
+++ b/Makefile
@@ -6,7 +6,7 @@ all: spl
man: spl.1
-spl: spl.icl lex.icl lex.dcl parse.icl parse.dcl spl.prj sem.icl sem.dcl
+spl: spl.icl lex.icl lex.dcl parse.icl parse.dcl spl.prj sem.icl sem.dcl AST.icl AST.dcl
$(CPM) make
%.1: %
diff --git a/grammar/grammar.txt b/grammar/grammar.txt
index 78e5450..98bb06e 100644
--- a/grammar/grammar.txt
+++ b/grammar/grammar.txt
@@ -1,6 +1,7 @@
<Prog> ::= <FunDecl>+
<FunDecl> ::= <id> '(' <Type>* ')' ['::' <FunType] '{' <VarDecl>* <Stmt>+ '}'
<FunType> ::= <VoidType> ['->' <FunType>]
+ | '(' <FunType> ')'
<Stmt> ::= 'if' '(' <Expr> ')' '{' <Stmt>* '}' ['else' '{' <Stmt>* '}']
| 'while' '(' <Expr> ')' '{' <Stmt>* '}'
| <id> <FieldSels> '=' <Expr> ';'
diff --git a/parse.icl b/parse.icl
index ab575b6..766f1ce 100644
--- a/parse.icl
+++ b/parse.icl
@@ -75,7 +75,9 @@ parseFunType :: Parser Token Type
parseFunType = satTok DoubleColonToken *> parseFT
where
parseFT :: Parser Token Type
- parseFT = ((->>) <$> parseType <* satTok ArrowToken <*> parseFT) <|> parseType
+ parseFT = (liftM2 (->>)
+ ((parseBBraces parseFT <|> parseType) <* satTok ArrowToken)
+ parseFT) <|> parseType
parseVarDecl :: Parser Token VarDecl
parseVarDecl = liftM4 VarDecl
@@ -144,10 +146,10 @@ parseVarDef = liftM2 VarDef parseIdent parseFieldSelectors
parseFieldSelectors :: Parser Token [FieldSelector]
parseFieldSelectors = many (satTok DotToken *> (
- (parseIdent >>= (\i.if (i == "hd") (pure FieldHd) empty)) <|>
- (parseIdent >>= \i.if (i == "tl") (pure FieldTl) empty) <|>
- (parseIdent >>= \i.if (i == "fst") (pure FieldFst) empty) <|>
- (parseIdent >>= \i.if (i == "snd") (pure FieldSnd) empty)))
+ (parseIdent >>= \i.if (i == "hd") (pure FieldHd) empty) <|>
+ (parseIdent >>= \i.if (i == "tl") (pure FieldTl) empty) <|>
+ (parseIdent >>= \i.if (i == "fst") (pure FieldFst) empty) <|>
+ (parseIdent >>= \i.if (i == "snd") (pure FieldSnd) empty)))
parseOp1 :: Parser Token Op1
parseOp1 = trans1 DashToken UnMinus <|> trans1 ExclamationToken UnNegation
@@ -163,7 +165,7 @@ parseBSqBraces p = satTok SquareOpenToken *> p <* satTok SquareCloseToken
parseTuple :: (Parser Token a) -> Parser Token (a, a)
parseTuple p = satTok BraceOpenToken *>
- (liftM2 (\a->(\b->(a,b))) (p <* satTok CommaToken) p)
+ (liftM2 tuple (p <* satTok CommaToken) p)
<* satTok BraceCloseToken
trans :: TokenValue (TokenValue -> a) -> Parser Token (Pos, a)
diff --git a/sem.icl b/sem.icl
index 46749ba..23fb04a 100644
--- a/sem.icl
+++ b/sem.icl
@@ -37,13 +37,15 @@ variableStream :: [String]
variableStream = map toString [1..]
sem :: AST -> SemOutput
-sem (AST fd) = Right $ (AST fd, 'Map'.newMap)
+sem (AST fd) = Right (AST fd, 'Map'.newMap)
instance toString Scheme where
- toString (Forall x t) = concat ["Forall ": map ((+++) "\n") x] +++ toString t
+ toString (Forall x t) =
+ concat ["Forall ": map ((+++) "\n") x] +++ toString t
instance toString Gamma where
- toString mp = concat [concat [k, ": ", toString v, "\n"]\\(k, v)<-'Map'.toList mp]
+ toString mp =
+ concat [concat [k, ": ", toString v, "\n"]\\(k, v)<-'Map'.toList mp]
instance toString SemError where
toString se = "SemError: "
--
2.20.1