radumaco/RosettaHaskellCompiler
1
0
Fork 0
mirror of https://github.com/macocianradu/RosettaHaskellCompiler.git synced 2026-03-18 21:10:07 +00:00
Code Issues Packages Projects Releases Wiki Activity

fixed types to be capitalized

Browse Source
This commit is contained in:
macocianradu
2021-11-30 21:20:02 +01:00
parent d14c1de4cf
commit 70baa17a4e
4 changed files with 26 additions and 8 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
RosettaParser.cabal
View File

@@ -40,6 +40,7 @@ library
PrettyPrinter.RosettaObject PrettyPrinter.RosettaObject
PrettyPrinter.Type PrettyPrinter.Type
Semantic.ExpressionChecker Semantic.ExpressionChecker
Semantic.FunctionChecker
Semantic.TypeChecker Semantic.TypeChecker
other-modules: other-modules:
Paths_RosettaParser Paths_RosettaParser

13
app/Main.hs
View File

@@ -12,6 +12,7 @@ import PrettyPrinter.Type
import PrettyPrinter.Function import PrettyPrinter.Function
import Semantic.TypeChecker import Semantic.TypeChecker
import Semantic.ExpressionChecker import Semantic.ExpressionChecker
import Semantic.FunctionChecker
import Model.Function import Model.Function
import Model.Type import Model.Type
import System.Environment.Blank (getArgs) import System.Environment.Blank (getArgs)
@@ -26,7 +27,7 @@ main = do
case parse rosettaParser "" (Text.pack rosettaString) of case parse rosettaParser "" (Text.pack rosettaString) of
Left errorBundle -> print (errorBundlePretty errorBundle) Left errorBundle -> print (errorBundlePretty errorBundle)
Right objs -> do Right objs -> do
putStrLn $ printObjects (definedTypes, definedFunctions) objs writeFile (args !! 1) (printObjects (definedTypes, definedFunctions) objs)
where where
definedFunctions = addNewFunctions (definedTypes, defaultMap) objs definedFunctions = addNewFunctions (definedTypes, defaultMap) objs
definedTypes = addNewTypes [] objs definedTypes = addNewTypes [] objs
@@ -39,15 +40,15 @@ printObjects (t, s) objs
printObject :: ([Type], [Symbol]) -> RosettaObject -> Either [TypeCheckError] String printObject :: ([Type], [Symbol]) -> RosettaObject -> Either [TypeCheckError] String
printObject (definedTypes, _) (TypeObject t) printObject (definedTypes, _) (TypeObject t)
| isRight checked = Right $ printType t | isRight checked = Right $ printType $ fromRightUnsafe checked
| otherwise = Left $ fromLeftUnsafe checked | otherwise = Left $ fromLeftUnsafe checked
where checked = checkType definedTypes t where checked = checkType definedTypes t
printObject _ (EnumObject e) = Right $ printEnum e printObject _ (EnumObject e) = Right $ printEnum e
printObject (_, definedFunctions) (FunctionObject (MakeFunction name desc inp out ex)) printObject (definedTypes, definedFunctions) (FunctionObject fun)
| isRight checked = Right $ printFunction (MakeFunction name desc inp out ex) | isRight checked = Right $ printFunction $ fromRightUnsafe checked
| otherwise = Left [fromLeftUnsafe checked] | otherwise = Left $ fromLeftUnsafe checked
where where
checked = checkExpression definedFunctions ex checked = checkFunction (definedTypes, definedFunctions) fun
addNewFunctions :: ([Type], [Symbol]) -> [RosettaObject] -> [Symbol] addNewFunctions :: ([Type], [Symbol]) -> [RosettaObject] -> [Symbol]
addNewFunctions (_, s) [] = s addNewFunctions (_, s) [] = s

4
src/PrettyPrinter/Function.hs
View File

@@ -24,9 +24,9 @@ printExpression (Parens ex) = "(" <> printExpression ex <> ")"
printExpression (List ex) = list (map printExpression ex) printExpression (List ex) = list (map printExpression ex)
printExpression (Function name ex) = pretty name <> tupled (map printExpression ex) printExpression (Function name ex) = pretty name <> tupled (map printExpression ex)
printExpression (PrefixExp name ex) = pretty name <+> printExpression ex printExpression (PrefixExp name ex) = pretty name <+> printExpression ex
printExpression (PostfixExp name ex) = printExpression ex <+> pretty name printExpression (PostfixExp name ex) = pretty name <+> printExpression ex
printExpression (InfixExp name ex1 ex2) = printExpression ex1 <+> pretty name <+> printExpression ex2 printExpression (InfixExp name ex1 ex2) = printExpression ex1 <+> pretty name <+> printExpression ex2
printExpression (IfSimple cond ex) = "if" <+> printExpression cond <+> "then" <+> printExpression ex printExpression (IfSimple cond ex) = "if" <+> printExpression cond <+> "then" <+> printExpression ex <+> "else" <+> "pure ()"
printExpression (IfElse cond ex1 ex2) = "if" <+> printExpression cond <+> "then" <+> printExpression ex1 <+> "else" <+> printExpression ex2 printExpression (IfElse cond ex1 ex2) = "if" <+> printExpression cond <+> "then" <+> printExpression ex1 <+> "else" <+> printExpression ex2
printFunctionSignature :: Function -> Doc a printFunctionSignature :: Function -> Doc a

16
src/Semantic/FunctionChecker.hs Normal file
View File

@@ -0,0 +1,16 @@
module Semantic.FunctionChecker where
import Model.Function
import Model.Type
import Semantic.ExpressionChecker
import Semantic.TypeChecker
import Data.Either
checkFunction :: ([Type], [Symbol]) -> Function -> Either [TypeCheckError] Function
checkFunction (definedTypes, definedFunctions) (MakeFunction name desc inp out ex)
| isRight checkedEx && isRight checkedOut && null (lefts checkedIn) = Right $ MakeFunction name desc (rights checkedIn) (fromRightUnsafe checkedOut) ex
| otherwise = Left $ lefts [checkedOut] ++ lefts checkedIn ++ lefts [checkedEx]
where
checkedEx = checkExpression definedFunctions ex
checkedIn = checkAttributes definedTypes inp
checkedOut = head $ checkAttributes definedTypes [out]