initial commit

Author: Fabian Sundholm

.gitignore

@@ -0,0 +1,3 @@
+.stack-work/
+functional-parsing.cabal
+*~

ChangeLog.md

@@ -0,0 +1,3 @@
+# Changelog for functional-parsing
+
+## Unreleased changes

LICENSE

@@ -0,0 +1,30 @@
+Copyright Author name here (c) 2018
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Author name here nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

README.md

@@ -0,0 +1 @@
+# functional-parsing

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

app/Main.hs

@@ -0,0 +1,6 @@
+module Main where
+
+import Lib
+
+main :: IO ()
+main = someFunc

package.yaml

@@ -0,0 +1,48 @@
+name:                functional-parsing
+version:             0.1.0.0
+github:              "githubuser/functional-parsing"
+license:             BSD3
+author:              "Author name here"
+maintainer:          "example@example.com"
+copyright:           "2018 Author name here"
+
+extra-source-files:
+- README.md
+- ChangeLog.md
+
+# Metadata used when publishing your package
+# synopsis:            Short description of your package
+# category:            Web
+
+# To avoid duplicated efforts in documentation and dealing with the
+# complications of embedding Haddock markup inside cabal files, it is
+# common to point users to the README.md file.
+description:         Please see the README on GitHub at <https://github.com/githubuser/functional-parsing#readme>
+
+dependencies:
+- base >= 4.7 && < 5
+
+library:
+  source-dirs: src
+
+executables:
+  functional-parsing-exe:
+    main:                Main.hs
+    source-dirs:         app
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - functional-parsing
+
+tests:
+  functional-parsing-test:
+    main:                Spec.hs
+    source-dirs:         test
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - functional-parsing

src/CoreParser.hs

@@ -0,0 +1,62 @@
+module CoreParser(Parser, char, return, fail, (#), (!), (?), (#>), (>->),
+                  Parse, parse, toString, fromString) where
+import Prelude hiding (return, fail)
+infixl 3 ! 
+infixl 7 ?
+infixl 6 #
+infixl 5 >->
+infixl 4 #>
+
+class Parse a where
+    parse :: Parser a
+    fromString :: String -> a
+    fromString cs =
+        case parse cs of
+               Just(s, []) -> s
+               Just(s, cs) -> error ("garbage '"++cs++"'")
+               Nothing -> error "Nothing"
+    toString :: a -> String
+
+type Parser a = String -> Maybe (a, String)
+
+char :: Parser Char
+char []= Nothing
+char (c:cs) = Just (c, cs)
+
+return :: a -> Parser a
+return a cs = Just (a, cs)
+
+fail ::  Parser a 
+fail cs = Nothing
+
+(!) :: Parser a -> Parser a -> Parser a
+(m ! n) cs = case m cs of
+             Nothing -> n cs 
+             mcs -> mcs
+
+(?) :: Parser a -> (a -> Bool) -> Parser a
+(m ? p) cs = 
+    case m cs of
+    Nothing -> Nothing
+    Just(r, s) -> if p r then Just(r, s) else Nothing
+
+(#) :: Parser a -> Parser b -> Parser (a, b)
+(m # n) cs = 
+    case m cs of
+    Nothing -> Nothing
+    Just(a, cs') -> 
+        case n cs' of
+        Nothing -> Nothing
+        Just(b, cs'') -> Just((a, b), cs'')
+
+(>->) :: Parser a -> (a -> b) -> Parser b
+(m >-> b) cs = 
+    case m cs of
+    Just(a, cs') -> Just(b a, cs')
+    Nothing -> Nothing
+
+(#>) :: Parser a -> (a -> Parser b) -> Parser b 
+(p #> k) cs = 
+    case p cs of
+    Nothing -> Nothing
+    Just(a, cs') -> k a cs'

src/Dictionary.hs

@@ -0,0 +1,14 @@
+module Dictionary (T, empty, lookup, insert) where
+import Prelude hiding (lookup)
+import qualified Prelude
+
+newtype T a b = Dictionary [(a, b)] deriving (Show)
+
+empty :: (Eq a, Ord a) => T a b
+empty = Dictionary []
+
+lookup :: (Eq a, Ord a) => a -> T a b -> Maybe b
+lookup a (Dictionary dict) = Prelude.lookup a dict
+
+insert :: (Eq a, Ord a) => (a, b) -> T a b -> T a b
+insert pair (Dictionary dict)  = Dictionary (pair:dict)

src/Expr.hs

@@ -0,0 +1,78 @@
+module Expr(Expr, T, parse, fromString, value, toString) where
+
+{-
+   An expression of type Expr is a representation of an arithmetic expression 
+   with integer constants and variables. A variable is a string of upper- 
+   and lower case letters. The following functions are exported
+   
+   parse :: Parser Expr
+   fromString :: String -> Expr
+   toString :: Expr -> String
+   value :: Expr -> Dictionary.T String Int -> Int
+   
+   parse is a parser for expressions as defined by the module Parser.
+   It is suitable for use in parsers for languages containing expressions
+   as a sublanguage.
+   
+   fromString expects its argument to contain an expression and returns the 
+   corresponding Expr. 
+  
+   toString converts an expression to a string without unneccessary 
+   parentheses and such that fromString (toString e) = e.
+  
+   value e env evaluates e in an environment env that is represented by a
+   Dictionary.T Int.  
+-}
+import Prelude hiding (return, fail)
+import Parser hiding (T)
+import qualified Dictionary
+
+data Expr = Num Integer | Var String | Add Expr Expr 
+       | Sub Expr Expr | Mul Expr Expr | Div Expr Expr
+         deriving Show
+
+type T = Expr
+
+var, num, factor, term, expr :: Parser Expr
+
+term', expr' :: Expr -> Parser Expr
+
+var = word >-> Var
+
+num = number >-> Num
+
+mulOp = lit '*' >-> (\_ -> Mul) !
+        lit '/' >-> (\_ -> Div)
+
+addOp = lit '+' >-> (\_ -> Add) !
+        lit '-' >-> (\_ -> Sub)
+
+bldOp e (oper,e') = oper e e'
+
+factor = num !
+         var !
+         lit '(' -# expr #- lit ')' !
+         err "illegal factor"
+             
+term' e = mulOp # factor >-> bldOp e #> term' ! return e
+term = factor #> term'
+       
+expr' e = addOp # term >-> bldOp e #> expr' ! return e
+expr = term #> expr'
+
+parens cond str = if cond then "(" ++ str ++ ")" else str
+
+shw :: Int -> Expr -> String
+shw prec (Num n) = show n
+shw prec (Var v) = v
+shw prec (Add t u) = parens (prec>5) (shw 5 t ++ "+" ++ shw 5 u)
+shw prec (Sub t u) = parens (prec>5) (shw 5 t ++ "-" ++ shw 6 u)
+shw prec (Mul t u) = parens (prec>6) (shw 6 t ++ "*" ++ shw 6 u)
+shw prec (Div t u) = parens (prec>6) (shw 6 t ++ "/" ++ shw 7 u)
+
+value :: Expr -> Dictionary.T String Integer -> Integer
+value (Num n) _ = error "value not implemented"
+
+instance Parse Expr where
+    parse = expr
+    toString = shw 0

src/Lib.hs

@@ -0,0 +1,6 @@
+module Lib
+    ( someFunc
+    ) where
+
+someFunc :: IO ()
+someFunc = putStrLn "someFunc"

src/Makefile

@@ -0,0 +1,8 @@
+default:
+	@echo nothing done
+
+clean:
+	rm -f .BAK.* *~
+
+zip:	clean
+	cd ..; zip -r ass3 clean_parser_assignment

src/Parser.hs

@@ -0,0 +1,60 @@
+module Parser(module CoreParser, T, digit, digitVal, chars, letter, err,
+              lit, number, iter, accept, require, token,
+              spaces, word, (-#), (#-)) where
+import Prelude hiding (return, fail)
+import Data.Char
+import CoreParser
+infixl 7 -#, #- 
+
+type T a = Parser a
+
+err :: String -> Parser a
+err message cs = error (message++" near "++cs++"\n")
+
+iter :: Parser a -> Parser [a]  
+iter m = m # iter m >-> cons ! return [] 
+
+cons(a, b) = a:b
+
+(-#) :: Parser a -> Parser b -> Parser b
+m -# n = error "-# not implemented"
+
+(#-) :: Parser a -> Parser b -> Parser a
+m #- n = error "#- not implemented"
+
+spaces :: Parser String
+spaces =  error "spaces not implemented"
+
+token :: Parser a -> Parser a
+token m = m #- spaces
+
+letter :: Parser Char
+letter =  error "letter not implemented"
+
+word :: Parser String
+word = token (letter # iter letter >-> cons)
+
+chars :: Int -> Parser String
+chars n =  error "chars not implemented"
+
+accept :: String -> Parser String
+accept w = (token (chars (length w))) ? (==w)
+
+require :: String -> Parser String
+require w  = error "require not implemented"
+
+lit :: Char -> Parser Char
+lit c = token char ? (==c)
+
+digit :: Parser Char 
+digit = char ? isDigit 
+
+digitVal :: Parser Integer
+digitVal = digit >-> digitToInt >-> fromIntegral
+
+number' :: Integer -> Parser Integer
+number' n = digitVal #> (\ d -> number' (10*n+d))
+          ! return n
+number :: Parser Integer
+number = token (digitVal #> number')
+

src/Program.hs

@@ -0,0 +1,11 @@
+module Program(T, parse, fromString, toString, exec) where
+import Parser hiding (T)
+import qualified Statement
+import qualified Dictionary
+import Prelude hiding (return, fail)
+newtype T = Program () -- to be defined
+instance Parse T where
+  parse = error "Program.parse not implemented"
+  toString = error "Program.toString not implemented"
+             
+exec = error "Program.exec not implemented"

src/Statement.hs

@@ -0,0 +1,23 @@
+module Statement(T, parse, toString, fromString, exec) where
+import Prelude hiding (return, fail)
+import Parser hiding (T)
+import qualified Dictionary
+import qualified Expr
+type T = Statement
+data Statement =
+    Assignment String Expr.T |
+    If Expr.T Statement Statement
+    deriving Show
+
+assignment = word #- accept ":=" # Expr.parse #- require ";" >-> buildAss
+buildAss (v, e) = Assignment v e
+
+exec :: [T] -> Dictionary.T String Integer -> [Integer] -> [Integer]
+exec (If cond thenStmts elseStmts: stmts) dict input = 
+    if (Expr.value cond dict)>0 
+    then exec (thenStmts: stmts) dict input
+    else exec (elseStmts: stmts) dict input
+
+instance Parse Statement where
+  parse = error "Statement.parse not implemented"
+  toString = error "Statement.toString not implemented"

src/TestExpr.hs

@@ -0,0 +1,20 @@
+{- Test for Expr-}
+module TestExpr where
+
+import qualified Dictionary
+import Expr
+
+dict = Dictionary.insert ("x", 1) $
+       Dictionary.insert ("y", 2) $
+       Dictionary.empty 
+
+testValue string = value (fromString string) dict
+
+n1 = testValue "1"
+n2 = testValue "x"
+n3 = testValue "x+y"
+n4 = testValue "x-y-y"
+n21 = testValue "1/(2-y)" {-  Expr.value: division by 0 -}
+n31 = testValue "2+z"     {-  Expr.value: undefined variable z -}
+
+