diff --git a/src/Core/Examples.hs b/src/Core/Examples.hs index b83a21e..83b2c1a 100644 --- a/src/Core/Examples.hs +++ b/src/Core/Examples.hs @@ -77,3 +77,15 @@ facExample = [coreProg| main = fac 3; |] +corePrelude :: Module +corePrelude = Module (Just ("Prelude", [])) $ Program + [ ScDef "id" ["x"] (Var "x") + , ScDef "k" ["x", "y"] (Var "x") + , ScDef "k1" ["x", "y"] (Var "y") + , ScDef "succ" ["f", "g", "x"] (Var "f" :$ Var "x" :$ (Var "g" :$ Var "x")) + , ScDef "compose" ["f", "g", "x"] (Var "f" :$ (Var "g" :$ Var "x")) + , ScDef "twice" ["f", "x"] (Var "f" :$ (Var "f" :$ Var "x")) + , ScDef "False" [] $ Con 0 0 + , ScDef "True" [] $ Con 1 0 + ] + diff --git a/src/Core/Lex.x b/src/Core/Lex.x index 8d2fc8b..0aebd64 100644 --- a/src/Core/Lex.x +++ b/src/Core/Lex.x @@ -139,7 +139,7 @@ data Located a = Located Int Int Int a deriving Show constTok :: t -> AlexInput -> Int -> Alex (Located t) -constTok t (AlexPn _ y x,_,_,_) l = pure $ Located x y l t +constTok t (AlexPn _ y x,_,_,_) l = pure $ Located y x l t data CoreToken = TokenLet | TokenLetrec @@ -237,7 +237,7 @@ data ParseError = ParErrLexical String deriving Show lexWith :: (String -> CoreToken) -> Lexer -lexWith f (AlexPn _ y x,_,_,s) l = pure $ Located x y l (f $ take l s) +lexWith f (AlexPn _ y x,_,_,s) l = pure $ Located y x l (f $ take l s) lexToken :: Alex (Located CoreToken) lexToken = alexMonadScan @@ -250,21 +250,21 @@ getSrcCol = Alex $ \ st -> lbrace :: Lexer lbrace (AlexPn _ y x,_,_,_) l = do pushContext NoLayout - pure $ Located x y l TokenLBrace + pure $ Located y x l TokenLBrace rbrace :: Lexer rbrace (AlexPn _ y x,_,_,_) l = do popContext - pure $ Located x y l TokenRBrace + pure $ Located y x l TokenRBrace insRBraceV :: AlexPosn -> Alex (Located CoreToken) insRBraceV (AlexPn _ y x) = do popContext - pure $ Located x y 0 TokenRBraceV + pure $ Located y x 0 TokenRBraceV insSemi :: AlexPosn -> Alex (Located CoreToken) insSemi (AlexPn _ y x) = do - pure $ Located x y 0 TokenSemicolon + pure $ Located y x 0 TokenSemicolon modifyUst :: (AlexUserState -> AlexUserState) -> Alex () modifyUst f = do @@ -282,7 +282,7 @@ noBrace :: Lexer noBrace (AlexPn _ y x,_,_,_) l = do col <- getSrcCol pushContext (Layout col) - pure $ Located x y l TokenLBraceV + pure $ Located y x l TokenLBraceV getOffside :: Alex Ordering getOffside = do @@ -303,13 +303,13 @@ doBol (p,c,_,s) _ = do letin :: Lexer letin (AlexPn _ y x,_,_,_) l = do popContext - pure $ Located x y l TokenIn + pure $ Located y x l TokenIn topLevelOff :: Lexer topLevelOff = noBrace alexEOF :: Alex (Located CoreToken) alexEOF = Alex $ \ st@(AlexState { alex_pos = AlexPn _ y x }) -> - Right (st, Located x y 0 TokenEOF) + Right (st, Located y x 0 TokenEOF) } diff --git a/src/Core/Parse.y b/src/Core/Parse.y index ee93323..259faf3 100644 --- a/src/Core/Parse.y +++ b/src/Core/Parse.y @@ -138,9 +138,9 @@ Con : '(' consym ')' { $2 } { parseError :: [Located CoreToken] -> RLPC ParseError a -parseError (Located x y l _ : _) = addFatal err +parseError (Located y x l _ : _) = addFatal err where err = SrcError - { _errSpan = (x, y, l) + { _errSpan = (y,x,l) , _errSeverity = Error , _errDiagnostic = ParErrParse } diff --git a/src/Core/Syntax.hs b/src/Core/Syntax.hs index cc4aa86..18e3b7b 100644 --- a/src/Core/Syntax.hs +++ b/src/Core/Syntax.hs @@ -10,7 +10,6 @@ module Core.Syntax , ScDef(..) , Module(..) , Program(..) - , corePrelude , bindersOf , rhssOf , isAtomic @@ -139,18 +138,6 @@ isAtomic _ = False ---------------------------------------------------------------------------------- -corePrelude :: Module -corePrelude = Module (Just ("Prelude", [])) $ Program - [ ScDef "id" ["x"] (Var "x") - , ScDef "k" ["x", "y"] (Var "x") - , ScDef "k1" ["x", "y"] (Var "y") - , ScDef "succ" ["f", "g", "x"] (Var "f" :$ Var "x" :$ (Var "g" :$ Var "x")) - , ScDef "compose" ["f", "g", "x"] (Var "f" :$ (Var "g" :$ Var "x")) - , ScDef "twice" ["f", "x"] (Var "f" :$ (Var "f" :$ Var "x")) - , ScDef "False" [] $ Con 0 0 - , ScDef "True" [] $ Con 1 0 - ] - -- TODO: export list awareness insertModule :: Module -> Program -> Program insertModule (Module _ m) p = p <> m diff --git a/src/TIM.hs b/src/TIM.hs index 239eaaf..0d06a2c 100644 --- a/src/TIM.hs +++ b/src/TIM.hs @@ -50,6 +50,7 @@ data Prim = ConP Int Int -- ConP Tag Arity | IntDivP | IntNegP | IntEqP + | CasePairP deriving (Show, Eq) instance Pretty Prim where @@ -104,6 +105,7 @@ primitives = , ("/#", IntDivP) , ("==#", IntEqP) , ("if#", IfP) + , ("casePair#", CasePairP) ] instantiate :: Expr -> TiHeap -> [(Name, Addr)] -> (TiHeap, Addr)