diff --git a/src/Juvix/Compiler/Core/Transformation/NatToInt.hs b/src/Juvix/Compiler/Core/Transformation/NatToInt.hs index 8c7c22c40a..c43ffc1dea 100644 --- a/src/Juvix/Compiler/Core/Transformation/NatToInt.hs +++ b/src/Juvix/Compiler/Core/Transformation/NatToInt.hs @@ -17,8 +17,9 @@ convertNode tab = convert [] 0 go levels bl node = case node of NVar (Var {..}) -> End' (mkVar _varInfo (_varIndex + length (filter (\x -> x >= bl - _varIndex) levels))) - NApp (App _ (NIdt (Ident {..})) l) | Just _identSymbol == tab ^. infoIntToNat -> - End' (convert levels bl l) + NApp (App _ (NIdt (Ident {..})) l) + | Just _identSymbol == tab ^. infoIntToNat -> + End' (convert levels bl l) NApp (App _ (NApp (App _ (NIdt (Ident {..})) l)) r) -> Recur' (levels, convertIdentApp node (\op -> mkBuiltinApp _identInfo op [l, r]) _identSymbol) NApp (App _ (NIdt (Ident {..})) l) -> @@ -97,6 +98,6 @@ natToInt tab = mapT (const (convertNode tab')) tab' tab' = case tab ^. infoIntToNat of Just sym -> - tab{_identContext = HashMap.insert sym (mkLambda' (mkVar' 0)) (tab ^. identContext)} + tab {_identContext = HashMap.insert sym (mkLambda' (mkVar' 0)) (tab ^. identContext)} Nothing -> tab diff --git a/src/Juvix/Compiler/Core/Translation/FromInternal.hs b/src/Juvix/Compiler/Core/Translation/FromInternal.hs index 770dd6857a..216d7fb846 100644 --- a/src/Juvix/Compiler/Core/Translation/FromInternal.hs +++ b/src/Juvix/Compiler/Core/Translation/FromInternal.hs @@ -29,32 +29,37 @@ mkIdentIndex :: Name -> Text mkIdentIndex = show . (^. Internal.nameId . Internal.unNameId) setupIntToNat :: Symbol -> InfoTable -> InfoTable -setupIntToNat sym tab = tab{ - _infoIdentifiers = HashMap.insert sym ii (tab ^. infoIdentifiers), - _identContext = HashMap.insert sym node (tab ^. identContext), - _infoIntToNat = Just sym - } - where - ii = IdentifierInfo { - _identifierSymbol = sym, - _identifierName = "intToNat", - _identifierLocation = Nothing, - _identifierArgsNum = 1, - _identifierArgsInfo = [ArgumentInfo { - _argumentName = "x", - _argumentLocation = Nothing, - _argumentType = mkTypePrim' (PrimInteger $ PrimIntegerInfo Nothing Nothing), - _argumentIsImplicit = Explicit - }], - _identifierType = mkDynamic', - _identifierIsExported = False, - _identifierBuiltin = Nothing +setupIntToNat sym tab = + tab + { _infoIdentifiers = HashMap.insert sym ii (tab ^. infoIdentifiers), + _identContext = HashMap.insert sym node (tab ^. identContext), + _infoIntToNat = Just sym } + where + ii = + IdentifierInfo + { _identifierSymbol = sym, + _identifierName = "intToNat", + _identifierLocation = Nothing, + _identifierArgsNum = 1, + _identifierArgsInfo = + [ ArgumentInfo + { _argumentName = "x", + _argumentLocation = Nothing, + _argumentType = mkTypePrim' (PrimInteger $ PrimIntegerInfo Nothing Nothing), + _argumentIsImplicit = Explicit + } + ], + _identifierType = mkDynamic', + _identifierIsExported = False, + _identifierBuiltin = Nothing + } node = case (tagZeroM, tagSucM, boolSymM) of (Just tagZero, Just tagSuc, Just boolSym) -> mkLambda' $ - mkIf' boolSym + mkIf' + boolSym (mkBuiltinApp' OpEq [mkVar' 0, mkConstant' (ConstInteger 0)]) (mkConstr (setInfoName "zero" mempty) tagZero []) (mkConstr (setInfoName "suc" mempty) tagSuc [mkApp' (mkIdent' sym) (mkBuiltinApp' OpIntSub [mkVar' 0, mkConstant' (ConstInteger 1)])]) @@ -74,7 +79,7 @@ fromInternal i = do } where tab0 :: InfoTable - tab0 = emptyInfoTable{_infoIntToNat = Just intToNatSym, _infoNextSymbol = intToNatSym + 1} + tab0 = emptyInfoTable {_infoIntToNat = Just intToNatSym, _infoNextSymbol = intToNatSym + 1} intToNatSym :: Symbol intToNatSym = 0