~jojo/Carth

c2fce6483b8588499fd251423fc5f3d40be98f8a — JoJo 1 year, 5 months ago 922c02f
Implement binops as "builtin virtual functions"

This way, they only need to be declared for the typechecker and
handled in the codegen, but they don't need to exist as variants in
the AST for the intermediate compilation steps. Some existing variants
could maybe be handled this way too, like transmute.
8 files changed, 286 insertions(+), 119 deletions(-)

M src/Codegen.hs
M src/Extern.hs
M src/Gen.hs
M src/Infer.hs
M src/Inferred.hs
M src/Pretty.hs
M std/iter.carth
M std/math.carth
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))