M src/Codegen.hs => src/Codegen.hs +21 -23
@@ 28,7 28,7 @@ import Data.Functor
import Data.Functor.Identity
import Data.Bifunctor
import Control.Applicative
-import Lens.Micro.Platform (use, assign)
+import Lens.Micro.Platform (use, assign, view)
import Misc
import SrcPos
@@ 246,7 246,7 @@ genExpr (Expr pos expr) = locally srcPos (pos <|>) $ do
parent <- use lambdaParentFunc <* assign lambdaParentFunc Nothing
case expr of
Lit c -> genConst c
- Var (TypedVar x t) -> lookupVar (TypedVar x t)
+ Var x -> lookupVar x
App f e _ -> genApp f e
If p c a -> genIf p c a
Fun (p, b) -> assign lambdaParentFunc parent *> genExprLambda p b
@@ 278,32 278,30 @@ genStrLit s = do
pure $ VVar $ ConstantOperand (LLConst.GlobalReference (LLType.ptr typeStr) var)
genTailApp :: Expr -> Expr -> Gen ()
-genTailApp fe' ae' =
- genBetaReduceApp genTailExpr genTailReturn (app (Just Tail)) (fe', [ae'])
+genTailApp fe' ae' = genBetaReduceApp genTailExpr genTailReturn Tail (fe', [ae'])
genApp :: Expr -> Expr -> Gen Val
-genApp fe' ae' = genBetaReduceApp genExpr pure (app (Just NoTail)) (fe', [ae'])
+genApp fe' ae' = genBetaReduceApp genExpr pure NoTail (fe', [ae'])
-- | Beta-reduction and closure application
genBetaReduceApp
- :: (Expr -> Gen a)
- -> (Val -> Gen a)
- -> (Val -> Val -> Gen Val)
- -> (Expr, [Expr])
- -> Gen a
-genBetaReduceApp genExpr' returnMethod app' = \case
- (Expr _ (Fun (p, (b, _))), ae : aes) -> do
- a <- genExpr ae
- withVal p a (genBetaReduceApp genExpr' returnMethod app' (b, aes))
- (Expr _ (App fe ae _), aes) ->
- genBetaReduceApp genExpr' returnMethod app' (fe, ae : aes)
- (fe, []) -> genExpr' fe
- (fe, aes) -> do
- f <- genExpr fe
- as <- mapM genExpr (init aes)
- closure <- foldlM (app (Just NoTail)) f as
- arg <- genExpr (last aes)
- returnMethod =<< app' closure arg
+ :: (Expr -> Gen a) -> (Val -> Gen a) -> TailCallKind -> (Expr, [Expr]) -> Gen a
+genBetaReduceApp genExpr' returnMethod tail' applic = view env >>= \env' ->
+ case applic of
+ (Expr _ (Fun (p, (b, _))), ae : aes) -> do
+ a <- genExpr ae
+ withVal p a (genBetaReduceApp genExpr' returnMethod tail' (b, aes))
+ (Expr _ (App fe ae _), aes) ->
+ genBetaReduceApp genExpr' returnMethod tail' (fe, ae : aes)
+ (fe, []) -> genExpr' fe
+ (Expr _ (Var x), aes) | not (Map.member x env') ->
+ returnMethod =<< genAppBuiltinVirtual x (map genExpr aes)
+ (fe, aes) -> do
+ f <- genExpr fe
+ as <- mapM genExpr (init aes)
+ closure <- foldlM (app (Just NoTail)) f as
+ arg <- genExpr (last aes)
+ returnMethod =<< app (Just tail') closure arg
app :: Maybe TailCallKind -> Val -> Val -> Gen Val
app tailkind closure a = do
M src/Extern.hs => src/Extern.hs +45 -57
@@ 62,60 62,48 @@ genExtern (name, t, pos) = do
pure (externDef : wrapperDefs)
genWrapper :: SrcPos -> String -> Type -> [M.Type] -> Gen' [Definition]
-genWrapper pos externName rt paramTs =
- case (zipWith (TypedVar . ("x" ++) . show) [1 :: Word ..] paramTs) of
- [] -> ice "genWrapper of empty param list"
- (firstParam : restParams) -> do
- let genCallExtern :: [TypedVar] -> Gen Val
- genCallExtern vars = do
- ts <- mapM (\(TypedVar _ t) -> genType t) vars
- vars' <- mapM lookupVar vars
- as <- forM (zip vars' ts) $ \(v, t) -> passByRef t >>= \case
- True -> fmap (, [ByVal]) (getVar v)
- False -> fmap (, []) (getLocal v)
- let ats = map (typeOf . fst) as
- let fname = mkName externName
- passByRef rt >>= \case
- True -> do
- out <- emitReg "out" (alloca rt)
- let f = ConstantOperand $ LLConst.GlobalReference
- (LLType.ptr $ FunctionType LLType.void
- (typeOf out : ats)
- False
- )
- fname
- emitDo $ callExtern f ((out, [SRet]) : as)
- pure (VVar out)
- False ->
- let f = ConstantOperand $ LLConst.GlobalReference
- (LLType.ptr $ FunctionType rt ats False)
- fname
- in if rt == LLType.void
- then emitDo (callExtern f as) $> VLocal litUnit
- else fmap VLocal $ emitAnonReg $ WithRetType
- (callExtern f as)
- rt
- let
- genWrapper' fvs ps' = do
- r <- getLocal =<< case ps' of
- [] -> genCallExtern fvs
- (p : ps) -> do
- pts <- mapM (\(TypedVar _ t) -> genType t) ps
- let bt = foldr closureType rt pts
- genLambda fvs p (genWrapper' (fvs ++ [p]) ps $> (), bt)
- if typeOf r == typeUnit
- then commitFinalFuncBlock retVoid $> LLType.void
- else commitFinalFuncBlock (ret r) $> typeOf r
- let wrapperName = "_wrapper_" ++ externName
- assign lambdaParentFunc (Just wrapperName)
- let fname = mkName (wrapperName ++ "_func")
- (f, gs) <- locallySet srcPos (Just pos)
- $ genFunDef
- (fname, [], pos, firstParam, genWrapper' [firstParam] restParams)
- let fref = LLConst.GlobalReference (LLType.ptr (typeOf f)) fname
- let captures = LLConst.Null (LLType.ptr typeUnit)
- let closure = litStruct [captures, fref]
- let closureDef = simpleGlobConst (mkName ("_wrapper_" ++ externName))
- (typeOf closure)
- closure
- pure (GlobalDefinition closureDef : GlobalDefinition f : gs)
+genWrapper pos externName rt = \case
+ [] -> ice "genWrapper of empty param list"
+ (firstParamT : restParamTs) -> do
+ let genCallExtern :: [TypedVar] -> Gen Val
+ genCallExtern vars = do
+ ts <- mapM (\(TypedVar _ t) -> genType t) vars
+ vars' <- mapM lookupVar vars
+ as <- forM (zip vars' ts) $ \(v, t) -> passByRef t >>= \case
+ True -> fmap (, [ByVal]) (getVar v)
+ False -> fmap (, []) (getLocal v)
+ let ats = map (typeOf . fst) as
+ let fname = mkName externName
+ passByRef rt >>= \case
+ True -> do
+ out <- emitReg "out" (alloca rt)
+ let f = ConstantOperand $ LLConst.GlobalReference
+ (LLType.ptr
+ $ FunctionType LLType.void (typeOf out : ats) False
+ )
+ fname
+ emitDo $ callExtern f ((out, [SRet]) : as)
+ pure (VVar out)
+ False ->
+ let f = ConstantOperand $ LLConst.GlobalReference
+ (LLType.ptr $ FunctionType rt ats False)
+ fname
+ in if rt == LLType.void
+ then emitDo (callExtern f as) $> VLocal litUnit
+ else fmap VLocal $ emitAnonReg $ WithRetType
+ (callExtern f as)
+ rt
+ let genWrapper' fvs ps' = genTailWrapInLambdas rt fvs ps' genCallExtern
+ let wrapperName = "_wrapper_" ++ externName
+ assign lambdaParentFunc (Just wrapperName)
+ let fname = mkName (wrapperName ++ "_func")
+ let firstParam = TypedVar "x" firstParamT
+ (f, gs) <- locallySet srcPos (Just pos)
+ $ genFunDef (fname, [], pos, firstParam, genWrapper' [firstParam] restParamTs)
+ let fref = LLConst.GlobalReference (LLType.ptr (typeOf f)) fname
+ let captures = LLConst.Null (LLType.ptr typeUnit)
+ let closure = litStruct [captures, fref]
+ let closureDef = simpleGlobConst (mkName ("_wrapper_" ++ externName))
+ (typeOf closure)
+ closure
+ pure (GlobalDefinition closureDef : GlobalDefinition f : gs)
M src/Gen.hs => src/Gen.hs +179 -7
@@ 38,6 38,8 @@ import qualified LLVM.AST.Global as LLGlob
import qualified LLVM.AST.AddrSpace as LLAddr
import qualified LLVM.AST.Linkage as LLLink
import qualified LLVM.AST.Visibility as LLVis
+import qualified LLVM.AST.IntegerPredicate as LLIPred
+import qualified LLVM.AST.FloatingPointPredicate as LLFPred
import qualified LLSubprog
import Misc
@@ 225,6 227,33 @@ genFunDef (name, fvs, dpos, ptv@(TypedVar px pt), genBody) = do
Name s -> s
UnName n -> fromString (show n)
+genTailWrapInLambdas
+ :: Type -> [TypedVar] -> [M.Type] -> ([TypedVar] -> Gen Val) -> Gen Type
+genTailWrapInLambdas rt fvs ps genBody =
+ genWrapInLambdas rt fvs ps genBody >>= getLocal >>= \r -> if typeOf r == typeUnit
+ then commitFinalFuncBlock retVoid $> LLType.void
+ else commitFinalFuncBlock (ret r) $> typeOf r
+
+genWrapInLambdas :: Type -> [TypedVar] -> [M.Type] -> ([TypedVar] -> Gen Val) -> Gen Val
+genWrapInLambdas rt fvs pts genBody = do
+ case pts of
+ [] -> genBody fvs
+ (pt : pts') -> do
+ let p = TypedVar ("x" ++ show (length fvs)) pt
+ bt <- foldr closureType rt <$> mapM genType pts'
+ genWrapInLambdas' rt fvs p pts' genBody bt
+
+genWrapInLambdas'
+ :: Type
+ -> [TypedVar]
+ -> TypedVar
+ -> [M.Type]
+ -> ([TypedVar] -> Gen Val)
+ -> Type
+ -> Gen Val
+genWrapInLambdas' rt fvs p ps' genBody bt =
+ genLambda fvs p (genTailWrapInLambdas rt (fvs ++ [p]) ps' genBody $> (), bt)
+
-- TODO: Eta-conversion
-- | A lambda is a pair of a captured environment and a function. The captured
-- environment must be on the heap, since the closure value needs to be of
@@ 254,14 283,14 @@ populateCaptures ptrGeneric fvXs = do
emitDo (store captures ptr)
genLambda' :: TypedVar -> (Gen (), Type) -> Val -> [TypedVar] -> Gen Val
-genLambda' p@(TypedVar _ pt) (b, bt) captures fvXs = do
+genLambda' p@(TypedVar _ pt) (genBody, bt) captures fvXs = do
fname <- use lambdaParentFunc >>= \case
Just s -> fmap (mkName . ((s ++ "_func_") ++) . show) (outerLambdaN <<+= 1)
Nothing -> newName "func"
ft <- genType pt <&> \pt' -> closureFunType pt' bt
let f = VLocal $ ConstantOperand $ LLConst.GlobalReference (LLType.ptr ft) fname
pos <- view (srcPos . to (fromMaybe (ice "srcPos is Nothing in genLambda")))
- scribe outFuncs [(fname, fvXs, pos, p, b $> bt)]
+ scribe outFuncs [(fname, fvXs, pos, p, genBody $> bt)]
genStruct [captures, f]
compileUnitRef :: MDRef LLOp.DICompileUnit
@@ 424,11 453,91 @@ genStackAllocated v = do
emitDo (store v ptr)
pure ptr
-lookupVar :: MonadReader Env m => TypedVar -> m Val
-lookupVar x = do
- view (env . to (Map.lookup x)) >>= \case
- Just var -> pure (VVar var)
- Nothing -> ice $ "Undefined variable " ++ show x
+lookupVar :: TypedVar -> Gen Val
+lookupVar x = lookupVar' x >>= \case
+ Just y -> pure y
+ Nothing -> genAppBuiltinVirtual x []
+
+lookupVar' :: MonadReader Env m => TypedVar -> m (Maybe Val)
+lookupVar' x = do
+ view (env . to (Map.lookup x)) >>= pure . fmap VVar
+
+genAppBuiltinVirtual :: TypedVar -> [Gen Val] -> Gen Val
+genAppBuiltinVirtual (TypedVar g t) aes = do
+ as <- sequence aes
+ let wrap xts genRt f = do
+ rt' <- genRt
+ genWrapInLambdas rt' [] (drop (length as) xts)
+ $ \bes -> mapM lookupVar bes >>= \bs -> f (as ++ bs)
+ let wrap2 (xt, rt, f) = wrap [xt, xt] rt (\xs -> f (xs !! 0) (xs !! 1))
+ case g of
+ "+" -> wrap2 $ arithm add add fadd t
+ "-" -> wrap2 $ arithm sub sub fsub t
+ "*" -> wrap2 $ arithm mul mul fmul t
+ "/" -> wrap2 $ arithm udiv sdiv fdiv t
+ "rem" -> wrap2 $ arithm urem srem frem t
+ "shift-l" -> wrap2 $ bitwise shl shl t
+ "shift-r" -> wrap2 $ bitwise lshr ashr t
+ "bit-and" -> wrap2 $ bitwise and' and' t
+ "bit-or" -> wrap2 $ bitwise or' or' t
+ "bit-xor" -> wrap2 $ bitwise xor xor t
+ -- NOTE: When comparing floats, one or both operands may be NaN. We can use either
+ -- the `o` or `u` prefix to change how NaNs are treated by `fcmp`. I'm not sure,
+ -- but I think that always using `o` will result in the most predictable code.
+ "=" -> wrap2 $ rel LLIPred.EQ LLIPred.EQ LLFPred.OEQ t
+ "/=" -> wrap2 $ rel LLIPred.NE LLIPred.NE LLFPred.ONE t
+ ">" -> wrap2 $ rel LLIPred.UGT LLIPred.SGT LLFPred.OGT t
+ ">=" -> wrap2 $ rel LLIPred.UGE LLIPred.SGE LLFPred.OGE t
+ "<" -> wrap2 $ rel LLIPred.ULT LLIPred.SLT LLFPred.OLT t
+ "<=" -> wrap2 $ rel LLIPred.ULE LLIPred.SLE LLFPred.OLE t
+ _ -> ice $ "genAppBuiltinVirtual: No builtin virtual function `" ++ g ++ "`"
+ where
+ arithm u s f = \case
+ M.TFun a@(M.TPrim p) (M.TFun b c) | a == b && a == c ->
+ ( a
+ , genType a
+ , \x y -> fmap VLocal . emitAnonReg =<< if isNat p
+ then liftA2 u (getLocal x) (getLocal y)
+ else if isInt p
+ then liftA2 s (getLocal x) (getLocal y)
+ else liftA2 f (getLocal x) (getLocal y)
+ )
+ _ -> noInst
+ bitwise u s = \case
+ M.TFun a@(M.TPrim p) (M.TFun b c) | a == b && a == c && (isInt p || isNat p) ->
+ ( a
+ , genType a
+ , \x y -> fmap VLocal . emitAnonReg =<< if isNat p
+ then liftA2 u (getLocal x) (getLocal y)
+ else liftA2 s (getLocal x) (getLocal y)
+ )
+ _ -> noInst
+ rel u s f = \case
+ M.TFun a@(M.TPrim p) (M.TFun b _) | a == b ->
+ ( a
+ , pure typeBool
+ , \x y ->
+ fmap VLocal . emitAnonReg . flip zext i8 =<< emitAnonReg =<< if isNat p
+ then liftA2 (icmp u) (getLocal x) (getLocal y)
+ else if isInt p
+ then liftA2 (icmp s) (getLocal x) (getLocal y)
+ else liftA2 (fcmp f) (getLocal x) (getLocal y)
+ )
+ _ -> noInst
+ isNat = \case
+ TNat8 -> True
+ TNat16 -> True
+ TNat32 -> True
+ TNat -> True
+ _ -> False
+ isInt = \case
+ TInt8 -> True
+ TInt16 -> True
+ TInt32 -> True
+ TInt -> True
+ _ -> False
+ noInst =
+ ice $ "No instance of builtin virtual function " ++ g ++ " for type " ++ pretty t
callBuiltin :: String -> [Operand] -> Gen FunInstr
callBuiltin f as = do
@@ 776,6 885,66 @@ retVoid = Ret Nothing []
switch :: Operand -> Name -> [(LLConst.Constant, Name)] -> Terminator
switch x def cs = Switch x def cs []
+add :: Operand -> Operand -> FunInstr
+add a b = WithRetType (Add False False a b) (typeOf a)
+
+fadd :: Operand -> Operand -> FunInstr
+fadd a b = WithRetType (FAdd noFastMathFlags a b) (typeOf a)
+
+sub :: Operand -> Operand -> FunInstr
+sub a b = WithRetType (Sub False False a b) (typeOf a)
+
+fsub :: Operand -> Operand -> FunInstr
+fsub a b = WithRetType (FSub noFastMathFlags a b) (typeOf a)
+
+mul :: Operand -> Operand -> FunInstr
+mul a b = WithRetType (Mul False False a b) (typeOf a)
+
+fmul :: Operand -> Operand -> FunInstr
+fmul a b = WithRetType (FMul noFastMathFlags a b) (typeOf a)
+
+udiv :: Operand -> Operand -> FunInstr
+udiv a b = WithRetType (UDiv False a b) (typeOf a)
+
+sdiv :: Operand -> Operand -> FunInstr
+sdiv a b = WithRetType (SDiv False a b) (typeOf a)
+
+fdiv :: Operand -> Operand -> FunInstr
+fdiv a b = WithRetType (FDiv noFastMathFlags a b) (typeOf a)
+
+urem :: Operand -> Operand -> FunInstr
+urem a b = WithRetType (URem a b) (typeOf a)
+
+srem :: Operand -> Operand -> FunInstr
+srem a b = WithRetType (SRem a b) (typeOf a)
+
+frem :: Operand -> Operand -> FunInstr
+frem a b = WithRetType (FRem noFastMathFlags a b) (typeOf a)
+
+shl :: Operand -> Operand -> FunInstr
+shl a b = WithRetType (Shl False False a b) (typeOf a)
+
+lshr :: Operand -> Operand -> FunInstr
+lshr a b = WithRetType (LShr False a b) (typeOf a)
+
+ashr :: Operand -> Operand -> FunInstr
+ashr a b = WithRetType (AShr False a b) (typeOf a)
+
+and' :: Operand -> Operand -> FunInstr
+and' a b = WithRetType (And a b) (typeOf a)
+
+or' :: Operand -> Operand -> FunInstr
+or' a b = WithRetType (Or a b) (typeOf a)
+
+xor :: Operand -> Operand -> FunInstr
+xor a b = WithRetType (Xor a b) (typeOf a)
+
+icmp :: LLIPred.IntegerPredicate -> Operand -> Operand -> FunInstr
+icmp p a b = WithRetType (ICmp p a b) i1
+
+fcmp :: LLFPred.FloatingPointPredicate -> Operand -> Operand -> FunInstr
+fcmp p a b = WithRetType (FCmp p a b) i1
+
bitcast :: Operand -> Type -> FunInstr
bitcast x t = WithRetType (BitCast x t) t
@@ 788,6 957,9 @@ ptrtoint x t = WithRetType (PtrToInt x t) t
trunc :: Operand -> Type -> FunInstr
trunc x t = WithRetType (Trunc x t) t
+zext :: Operand -> Type -> FunInstr
+zext x t = WithRetType (ZExt x t) t
+
insertvalue :: Operand -> Operand -> [Word32] -> FunInstr
insertvalue s e is = WithRetType (InsertValue s e is) (typeOf s)
M src/Infer.hs => src/Infer.hs +4 -1
@@ 55,7 55,10 @@ type Infer a = ReaderT Env (StateT St (Except TypeErr)) a
inferTopDefs
:: TypeDefs -> Ctors -> Externs -> [Parsed.Def] -> Except TypeErr (Defs, Subst)
inferTopDefs tdefs ctors externs defs =
- let initEnv = Env { _envTypeDefs = tdefs, _envDefs = Map.empty, _envCtors = ctors }
+ let initEnv = Env { _envTypeDefs = tdefs
+ , _envDefs = builtinVirtuals
+ , _envCtors = ctors
+ }
initSt = St { _tvCount = 0, _substs = Map.empty }
in evalStateT (runReaderT inferTopDefs' initEnv) initSt
where
M src/Inferred.hs => src/Inferred.hs +27 -1
@@ 126,11 126,37 @@ ftv = \case
TBox t -> ftv t
TConst (_, ts) -> Set.unions (map ftv ts)
-builtinExterns :: Map String (Inferred.Type, SrcPos)
+builtinExterns :: Map String (Type, SrcPos)
builtinExterns = Map.fromList $ map
(second (, SrcPos "<builtin>" 0 0))
[("GC_malloc", TFun (TPrim TInt) (TBox (TConst tUnit)))]
+builtinVirtuals :: Map String Scheme
+builtinVirtuals =
+ let tva = TVExplicit (Parsed.Id (WithPos (SrcPos "<builtin>" 0 0) "a"))
+ ta = TVar tva
+ arithScm = Forall (Set.fromList [tva]) (TFun ta (TFun ta ta))
+ bitwiseScm = arithScm
+ relScm = Forall (Set.fromList [tva]) (TFun ta (TFun ta tBool))
+ in Map.fromList
+ $ [ ("+", arithScm)
+ , ("-", arithScm)
+ , ("*", arithScm)
+ , ("/", arithScm)
+ , ("rem", arithScm)
+ , ("shift-l", bitwiseScm)
+ , ("shift-r", bitwiseScm)
+ , ("bit-and", bitwiseScm)
+ , ("bit-or", bitwiseScm)
+ , ("bit-xor", bitwiseScm)
+ , ("=", relScm)
+ , ("/=", relScm)
+ , (">", relScm)
+ , (">=", relScm)
+ , ("<", relScm)
+ , ("<=", relScm)
+ ]
+
defSigs :: Def -> [(String, Scheme)]
defSigs = \case
VarDef d -> [defSig d]
M src/Pretty.hs => src/Pretty.hs +1 -1
@@ 181,7 181,7 @@ prettyStr s = '"' : (s >>= showChar) ++ "\""
prettyScheme :: (Pretty p, Pretty t) => Set p -> t -> String
prettyScheme ps t =
- concat ["(forall [" ++ spcPretty (Set.toList ps) ++ "] ", pretty t ++ ")"]
+ concat ["(forall (" ++ spcPretty (Set.toList ps) ++ ") ", pretty t ++ ")"]
prettyType :: Parsed.Type -> String
prettyType = \case
M std/iter.carth => std/iter.carth +6 -4
@@ 8,15 8,17 @@
(define (next (Iter it)) (it Unit))
(define next! (<o unwrap! next))
-(define (xrange a b) (take (-i b a) (range-from a)))
-(define (range a b) (take (inc (-i b a)) (range-from a)))
+(define: (xrange a b) (Fun Int Int (Iter Int))
+ (take (- b a) (range-from a)))
+(define: (range a b) (Fun Int Int (Iter Int))
+ (take (inc (- b a)) (range-from a)))
(define (range-from a)
(Iter (fun (_) (Some (Pair a (range-from (inc a)))))))
(define (take n xs)
- (Iter (if (>i n 0)
- (fun (_) (map-maybe (map-snd (take (-i n 1))) (next xs)))
+ (Iter (if (> n 0)
+ (fun (_) (map-maybe (map-snd (take (- n 1))) (next xs)))
(fun (_) None))))
(define (skip-while pred xs)
M std/math.carth => std/math.carth +3 -25
@@ 5,30 5,8 @@
(extern cos (Fun F64 F64))
(extern tan (Fun F64 F64))
-(define (inc n) (+i n 1))
-(define (dec n) (-i n 1))
-
-(extern +i (Fun Int Int Int))
-(extern -i (Fun Int Int Int))
-(extern *i (Fun Int Int Int))
-(extern /i (Fun Int Int Int))
-(extern =i (Fun Int Int Bool))
-(extern >i (Fun Int Int Bool))
-(define (>=i a b) (or (>i a b) (=i a b)))
-(define (<i a b) (not (>=i a b)))
-(define (<=i a b) (not (>i a b)))
-(extern remi (Fun Int Int Int))
-
-(extern +f (Fun F64 F64 F64))
-(extern -f (Fun F64 F64 F64))
-(extern *f (Fun F64 F64 F64))
-(extern /f (Fun F64 F64 F64))
-(extern =f (Fun F64 F64 Bool))
-(extern >f (Fun F64 F64 Bool))
-(define (>=f a b) (or (>f a b) (=f a b)))
-(define (<f a b) (not (>=f a b)))
-(define (<=f a b) (not (>f a b)))
-(extern remf (Fun F64 F64 F64))
+(define (inc n) (+ n 1))
+(define (dec n) (- n 1))
(define (and p q) (if p q False))
(define (or p q) (if p True q))
@@ 36,4 14,4 @@
(define not (fmatch (case True False)
(case False True)))
-(define (divisible? n m) (=i (remi n m) 0))
+(define (divisible? n m) (= (rem n m) 0))