mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-11 05:25:28 +03:00
feat: 'delete' interface (deciding whether a type is managed or not) (#1061)
* feat: 'delete' interface (deciding whether a type is managed or not) * refactor: Move implements function to Interface module * feat: Automatically implement 'delete' for types defined with `deftype` * fix: Don't implement `delete` for Pointer * refactor: Clarify `memberInfo` function * fix: Also check if function types are managed * fix: Implement 'delete' for String and StaticArray. * fix: Manage String and Pattern. Tests run! * feat: Add `managed?` primitive * docs: Note about primitiveIsManaged * test: Basic test cases for managed / nonmanaged external types * test: Make sure `managed?` primitive works * test: Inactivate sanitizer since we're creating leaks intentionally * feat: Removed 'isExternalType' function * refactor: Decide if struct member takes ref or not when printing ..based on blitable interface, and 'prn' implemntation * refactor: Use 'blit' everywhere * refactor: Implement `strTakesRefOrNot` in terms of `memberStrCallingConvention` * refactor: Use `remove` over `filter not`
This commit is contained in:
parent
fc7aecc825
commit
6f7aeaff73
59
core/Blitable.carp
Normal file
59
core/Blitable.carp
Normal file
@ -0,0 +1,59 @@
|
||||
(defmodule Int
|
||||
(defn blit [x] (the Int x))
|
||||
(implements blit Int.blit))
|
||||
|
||||
(defmodule Long
|
||||
(defn blit [x] (the Long x))
|
||||
(implements blit Long.blit))
|
||||
|
||||
(defmodule Float
|
||||
(defn blit [x] (the Float x))
|
||||
(implements blit Float.blit))
|
||||
|
||||
(defmodule Double
|
||||
(defn blit [x] (the Double x))
|
||||
(implements blit Double.blit))
|
||||
|
||||
(defmodule Char
|
||||
(defn blit [x] (the Char x))
|
||||
(implements blit Char.blit))
|
||||
|
||||
(defmodule Bool
|
||||
(defn blit [x] (the Bool x))
|
||||
(implements blit Bool.blit))
|
||||
|
||||
(defmodule Byte
|
||||
(defn blit [x] (the Byte x))
|
||||
(implements blit Byte.blit))
|
||||
|
||||
(defmodule Int8
|
||||
(defn blit [x] (the Int8 x))
|
||||
(implements blit Int8.blit))
|
||||
|
||||
(defmodule Int16
|
||||
(defn blit [x] (the Int16 x))
|
||||
(implements blit Int16.blit))
|
||||
|
||||
(defmodule Int32
|
||||
(defn blit [x] (the Int32 x))
|
||||
(implements blit Int32.blit))
|
||||
|
||||
(defmodule Int64
|
||||
(defn blit [x] (the Int64 x))
|
||||
(implements blit Int64.blit))
|
||||
|
||||
(defmodule Uint8
|
||||
(defn blit [x] (the Uint8 x))
|
||||
(implements blit Uint8.blit))
|
||||
|
||||
(defmodule Uint16
|
||||
(defn blit [x] (the Uint16 x))
|
||||
(implements blit Uint16.blit))
|
||||
|
||||
(defmodule Uint32
|
||||
(defn blit [x] (the Uint32 x))
|
||||
(implements blit Uint32.blit))
|
||||
|
||||
(defmodule Uint64
|
||||
(defn blit [x] (the Uint64 x))
|
||||
(implements blit Uint64.blit))
|
@ -16,6 +16,7 @@
|
||||
(system-include "carp_memory.h")
|
||||
|
||||
(load-once "Interfaces.carp")
|
||||
(load-once "Blitable.carp")
|
||||
(load-once "Bool.carp")
|
||||
(load-once "Macros.carp")
|
||||
(load-once "List.carp")
|
||||
|
@ -65,3 +65,5 @@
|
||||
(definterface tanh (λ [a] a))
|
||||
|
||||
(definterface slice (Fn [&a Int Int] a))
|
||||
|
||||
(definterface blit (Fn [a] a)) ; For types that can be freely memcopied -- exact name is up for discussion
|
||||
|
@ -43,6 +43,7 @@ If you want to replace all occurrences of the pattern, use `-1`.")
|
||||
(register = (Fn [&Pattern &Pattern] Bool))
|
||||
(implements = Pattern.=)
|
||||
(register delete (Fn [Pattern] ()))
|
||||
(implements delete Pattern.delete)
|
||||
(register copy (Fn [&Pattern] Pattern))
|
||||
(implements copy Pattern.copy)
|
||||
|
||||
|
@ -33,6 +33,7 @@
|
||||
(implements copy String.copy)
|
||||
(implements prn String.prn)
|
||||
(implements str String.str)
|
||||
(implements delete String.delete)
|
||||
|
||||
(doc head "Returns the character at start of string.")
|
||||
(defn head [s]
|
||||
|
@ -3,8 +3,8 @@
|
||||
module ArrayTemplates where
|
||||
|
||||
import Concretize
|
||||
import Managed
|
||||
import Obj
|
||||
import StructUtils
|
||||
import Template
|
||||
import ToTemplate
|
||||
import Types
|
||||
@ -611,15 +611,16 @@ strTy typeEnv env (StructTy _ [innerType]) =
|
||||
]
|
||||
strTy _ _ _ = []
|
||||
|
||||
takeAddressOrNot :: TypeEnv -> Ty -> String
|
||||
takeAddressOrNot typeEnv t = if isManaged typeEnv t then "&" else ""
|
||||
strTakesRefOrNot :: TypeEnv -> Env -> Ty -> String
|
||||
strTakesRefOrNot typeEnv env t =
|
||||
fst $ memberStrCallingConvention "str" typeEnv env t
|
||||
|
||||
calculateStrSize :: TypeEnv -> Env -> Ty -> String
|
||||
calculateStrSize typeEnv env t =
|
||||
case t of
|
||||
-- If the member type is Unit, don't access the element.
|
||||
UnitTy -> makeTemplate (\functionName -> (functionName ++ "();"))
|
||||
_ -> makeTemplate (\functionName -> (functionName ++ "(" ++ (takeAddressOrNot typeEnv t) ++ "((" ++ tyToC t ++ "*)a->data)[i]);"))
|
||||
_ -> makeTemplate (\functionName -> (functionName ++ "(" ++ (strTakesRefOrNot typeEnv env t) ++ "((" ++ tyToC t ++ "*)a->data)[i]);"))
|
||||
where
|
||||
makeTemplate :: (String -> String) -> String
|
||||
makeTemplate strcall =
|
||||
@ -632,7 +633,7 @@ calculateStrSize typeEnv env t =
|
||||
-- Get the size of the member type's string representation
|
||||
arrayMemberSizeCalc :: (String -> String) -> String
|
||||
arrayMemberSizeCalc strcall =
|
||||
case findFunctionForMemberIncludePrimitives typeEnv env "prn" (typesStrFunctionType typeEnv t) ("Inside array.", t) of
|
||||
case findFunctionForMemberIncludePrimitives typeEnv env "prn" (typesStrFunctionType typeEnv env t) ("Inside array.", t) of
|
||||
FunctionFound functionFullName ->
|
||||
unlines
|
||||
[ " temp = " ++ strcall functionFullName,
|
||||
@ -649,11 +650,11 @@ insideArrayStr :: TypeEnv -> Env -> Ty -> String
|
||||
insideArrayStr typeEnv env t =
|
||||
case t of
|
||||
UnitTy -> makeTemplate (\functionName -> functionName ++ "();")
|
||||
_ -> makeTemplate (\functionName -> functionName ++ "(" ++ (takeAddressOrNot typeEnv t) ++ "((" ++ tyToC t ++ "*)a->data)[i]);")
|
||||
_ -> makeTemplate (\functionName -> functionName ++ "(" ++ (strTakesRefOrNot typeEnv env t) ++ "((" ++ tyToC t ++ "*)a->data)[i]);")
|
||||
where
|
||||
makeTemplate :: (String -> String) -> String
|
||||
makeTemplate strcall =
|
||||
case findFunctionForMemberIncludePrimitives typeEnv env "prn" (typesStrFunctionType typeEnv t) ("Inside array.", t) of
|
||||
case findFunctionForMemberIncludePrimitives typeEnv env "prn" (typesStrFunctionType typeEnv env t) ("Inside array.", t) of
|
||||
FunctionFound functionFullName ->
|
||||
unlines
|
||||
[ " temp = " ++ strcall functionFullName,
|
||||
|
@ -700,28 +700,28 @@ depsOfPolymorphicFunction typeEnv env visitedDefinitions functionName functionTy
|
||||
-- | Helper for finding the 'delete' function for a type.
|
||||
depsForDeleteFunc :: TypeEnv -> Env -> Ty -> [XObj]
|
||||
depsForDeleteFunc typeEnv env t =
|
||||
if isManaged typeEnv t
|
||||
if isManaged typeEnv env t
|
||||
then depsOfPolymorphicFunction typeEnv env [] "delete" (FuncTy [t] UnitTy StaticLifetimeTy)
|
||||
else []
|
||||
|
||||
-- | Helper for finding the 'copy' function for a type.
|
||||
depsForCopyFunc :: TypeEnv -> Env -> Ty -> [XObj]
|
||||
depsForCopyFunc typeEnv env t =
|
||||
if isManaged typeEnv t
|
||||
if isManaged typeEnv env t
|
||||
then depsOfPolymorphicFunction typeEnv env [] "copy" (FuncTy [RefTy t (VarTy "q")] t StaticLifetimeTy)
|
||||
else []
|
||||
|
||||
-- | Helper for finding the 'str' function for a type.
|
||||
depsForPrnFunc :: TypeEnv -> Env -> Ty -> [XObj]
|
||||
depsForPrnFunc typeEnv env t =
|
||||
if isManaged typeEnv t
|
||||
if isManaged typeEnv env t
|
||||
then depsOfPolymorphicFunction typeEnv env [] "prn" (FuncTy [RefTy t (VarTy "q")] StringTy StaticLifetimeTy)
|
||||
else depsOfPolymorphicFunction typeEnv env [] "prn" (FuncTy [t] StringTy StaticLifetimeTy)
|
||||
|
||||
-- | The type of a type's str function.
|
||||
typesStrFunctionType :: TypeEnv -> Ty -> Ty
|
||||
typesStrFunctionType typeEnv memberType =
|
||||
if isManaged typeEnv memberType
|
||||
typesStrFunctionType :: TypeEnv -> Env -> Ty -> Ty
|
||||
typesStrFunctionType typeEnv env memberType =
|
||||
if isManaged typeEnv env memberType
|
||||
then FuncTy [RefTy memberType (VarTy "q")] StringTy StaticLifetimeTy
|
||||
else FuncTy [memberType] StringTy StaticLifetimeTy
|
||||
|
||||
@ -743,7 +743,7 @@ getConcretizedPath single functionType =
|
||||
-- | Used for finding functions like 'delete' or 'copy' for members of a Deftype (or Array).
|
||||
findFunctionForMember :: TypeEnv -> Env -> String -> Ty -> (String, Ty) -> FunctionFinderResult
|
||||
findFunctionForMember typeEnv env functionName functionType (memberName, memberType)
|
||||
| isManaged typeEnv memberType =
|
||||
| isManaged typeEnv env memberType =
|
||||
case allFunctionsWithNameAndSignature env functionName functionType of
|
||||
[] ->
|
||||
FunctionNotFound
|
||||
@ -1379,7 +1379,7 @@ manageMemory typeEnv globalEnv root =
|
||||
visit xobj
|
||||
unmanageArg :: XObj -> State MemState (Either TypeError XObj)
|
||||
unmanageArg xobj@(XObj _ _ (Just t)) =
|
||||
if isManaged typeEnv t
|
||||
if isManaged typeEnv globalEnv t
|
||||
then do
|
||||
r <- unmanage xobj
|
||||
pure $ case r of
|
||||
@ -1394,17 +1394,14 @@ manageMemory typeEnv globalEnv root =
|
||||
Just (RefTy _ _) -> Just (RefDeleter (varOfXObj xobj))
|
||||
Just t ->
|
||||
let var = varOfXObj xobj
|
||||
in if isExternalType typeEnv t
|
||||
then Just (FakeDeleter var)
|
||||
else
|
||||
if isManaged typeEnv t
|
||||
then case nameOfPolymorphicFunction typeEnv globalEnv (FuncTy [t] UnitTy StaticLifetimeTy) "delete" of
|
||||
Just pathOfDeleteFunc ->
|
||||
Just (ProperDeleter pathOfDeleteFunc var)
|
||||
Nothing ->
|
||||
--trace ("Found no delete function for " ++ var ++ " : " ++ (showMaybeTy (ty xobj)))
|
||||
Just (FakeDeleter var)
|
||||
else Just (PrimDeleter var)
|
||||
in if isManaged typeEnv globalEnv t
|
||||
then case nameOfPolymorphicFunction typeEnv globalEnv (FuncTy [t] UnitTy StaticLifetimeTy) "delete" of
|
||||
Just pathOfDeleteFunc ->
|
||||
Just (ProperDeleter pathOfDeleteFunc var)
|
||||
Nothing ->
|
||||
--trace ("Found no delete function for " ++ var ++ " : " ++ (showMaybeTy (ty xobj)))
|
||||
Just (FakeDeleter var)
|
||||
else Just (PrimDeleter var)
|
||||
Nothing -> error ("No type, can't manage " ++ show xobj)
|
||||
manage :: XObj -> State MemState ()
|
||||
manage xobj =
|
||||
@ -1438,7 +1435,7 @@ manageMemory typeEnv globalEnv root =
|
||||
unmanage :: XObj -> State MemState (Either TypeError ())
|
||||
unmanage xobj =
|
||||
let Just t = xobjTy xobj
|
||||
in if isManaged typeEnv t && not (isGlobalFunc xobj) && not (isExternalType typeEnv t)
|
||||
in if isManaged typeEnv globalEnv t && not (isGlobalFunc xobj)
|
||||
then do
|
||||
MemState deleters deps lifetimes <- get
|
||||
case deletersMatchingXObj xobj deleters of
|
||||
@ -1460,7 +1457,7 @@ manageMemory typeEnv globalEnv root =
|
||||
isGlobalVariable = case xobj of
|
||||
XObj (Sym _ (LookupGlobal _ _)) _ _ -> True
|
||||
_ -> False
|
||||
in if not isGlobalVariable && not (isGlobalFunc xobj) && isManaged typeEnv t && not (isExternalType typeEnv t) && not (isSymbolThatCaptures xobj) -- TODO: The 'isManaged typeEnv t' boolean check should be removed!
|
||||
in if not isGlobalVariable && not (isGlobalFunc xobj) && isManaged typeEnv globalEnv t && not (isSymbolThatCaptures xobj) -- TODO: The 'isManaged typeEnv t' boolean check should be removed!
|
||||
then do
|
||||
MemState deleters _ _ <- get
|
||||
pure $ case deletersMatchingXObj xobj deleters of
|
||||
@ -1517,7 +1514,7 @@ concreteDelete typeEnv env members =
|
||||
( \_ ->
|
||||
concatMap
|
||||
(depsOfPolymorphicFunction typeEnv env [] "delete" . typesDeleterFunctionType)
|
||||
(filter (isManaged typeEnv) (map snd members))
|
||||
(filter (isManaged typeEnv env) (map snd members))
|
||||
)
|
||||
|
||||
-- | The template for the 'delete' function of a concrete deftype BUT it takes a pointer.
|
||||
@ -1538,7 +1535,7 @@ concreteDeleteTakePtr typeEnv env members =
|
||||
( \_ ->
|
||||
concatMap
|
||||
(depsOfPolymorphicFunction typeEnv env [] "delete" . typesDeleterFunctionType)
|
||||
(filter (isManaged typeEnv) (map snd members))
|
||||
(filter (isManaged typeEnv env) (map snd members))
|
||||
)
|
||||
|
||||
-- | Generate the C code for deleting a single member of the deftype.
|
||||
@ -1566,7 +1563,7 @@ concreteCopy typeEnv env memberPairs =
|
||||
( \_ ->
|
||||
concatMap
|
||||
(depsOfPolymorphicFunction typeEnv env [] "copy" . typesCopyFunctionType)
|
||||
(filter (isManaged typeEnv) (map snd memberPairs))
|
||||
(filter (isManaged typeEnv env) (map snd memberPairs))
|
||||
)
|
||||
|
||||
tokensForCopy :: TypeEnv -> Env -> [(String, Ty)] -> [Token]
|
||||
@ -1599,7 +1596,7 @@ concreteCopyPtr typeEnv env memberPairs =
|
||||
( \_ ->
|
||||
concatMap
|
||||
(depsOfPolymorphicFunction typeEnv env [] "copy" . typesCopyFunctionType)
|
||||
(filter (isManaged typeEnv) (map snd memberPairs))
|
||||
(filter (isManaged typeEnv env) (map snd memberPairs))
|
||||
)
|
||||
|
||||
tokensForCopyPtr :: TypeEnv -> Env -> [(String, Ty)] -> [Token]
|
||||
|
@ -168,7 +168,7 @@ templateSetter typeEnv env memberName memberTy =
|
||||
)
|
||||
( \_ ->
|
||||
if
|
||||
| isManaged typeEnv memberTy -> depsOfPolymorphicFunction typeEnv env [] "delete" (typesDeleterFunctionType memberTy)
|
||||
| isManaged typeEnv env memberTy -> depsOfPolymorphicFunction typeEnv env [] "delete" (typesDeleterFunctionType memberTy)
|
||||
| isFunctionType memberTy -> [defineFunctionTypeAlias memberTy]
|
||||
| otherwise -> []
|
||||
)
|
||||
@ -206,7 +206,7 @@ templateGenericSetter pathStrings originalStructTy@(StructTy (ConcreteNameTy typ
|
||||
)
|
||||
)
|
||||
( \(FuncTy [_, memberTy] _ _) ->
|
||||
if isManaged typeEnv memberTy
|
||||
if isManaged typeEnv env memberTy
|
||||
then depsOfPolymorphicFunction typeEnv env [] "delete" (typesDeleterFunctionType memberTy)
|
||||
else []
|
||||
)
|
||||
@ -271,7 +271,7 @@ templateGenericMutatingSetter pathStrings originalStructTy@(StructTy (ConcreteNa
|
||||
)
|
||||
)
|
||||
( \(FuncTy [_, memberTy] _ _) ->
|
||||
if isManaged typeEnv memberTy
|
||||
if isManaged typeEnv env memberTy
|
||||
then depsOfPolymorphicFunction typeEnv env [] "delete" (typesDeleterFunctionType memberTy)
|
||||
else []
|
||||
)
|
||||
@ -447,7 +447,7 @@ concreteStr typeEnv env concreteStructTy@(StructTy (ConcreteNameTy typeName) _)
|
||||
)
|
||||
( \(FuncTy [RefTy (StructTy _ _) (VarTy "q")] StringTy _) ->
|
||||
concatMap
|
||||
(depsOfPolymorphicFunction typeEnv env [] "prn" . typesStrFunctionType typeEnv)
|
||||
(depsOfPolymorphicFunction typeEnv env [] "prn" . typesStrFunctionType typeEnv env)
|
||||
(remove isFullyGenericType (map snd memberPairs))
|
||||
)
|
||||
concreteStr _ _ _ _ _ = error "concretestr"
|
||||
@ -478,7 +478,7 @@ genericStr pathStrings originalStructTy@(StructTy (ConcreteNameTy typeName) _) m
|
||||
correctedMembers = replaceGenericTypeSymbolsOnMembers mappings membersXObjs
|
||||
memberPairs = memberXObjsToPairs correctedMembers
|
||||
in concatMap
|
||||
(depsOfPolymorphicFunction typeEnv env [] "prn" . typesStrFunctionType typeEnv)
|
||||
(depsOfPolymorphicFunction typeEnv env [] "prn" . typesStrFunctionType typeEnv env)
|
||||
(remove isFullyGenericType (map snd memberPairs))
|
||||
++ (if isTypeGeneric concreteStructTy then [] else [defineFunctionTypeAlias ft])
|
||||
)
|
||||
@ -571,7 +571,7 @@ genericDelete pathStrings originalStructTy@(StructTy (ConcreteNameTy typeName) _
|
||||
else
|
||||
concatMap
|
||||
(depsOfPolymorphicFunction typeEnv env [] "delete" . typesDeleterFunctionType)
|
||||
(filter (isManaged typeEnv) (map snd memberPairs))
|
||||
(filter (isManaged typeEnv env) (map snd memberPairs))
|
||||
)
|
||||
genericDelete _ _ _ = error "genericdelete"
|
||||
|
||||
@ -618,6 +618,6 @@ genericCopy pathStrings originalStructTy@(StructTy (ConcreteNameTy typeName) _)
|
||||
else
|
||||
concatMap
|
||||
(depsOfPolymorphicFunction typeEnv env [] "copy" . typesCopyFunctionType)
|
||||
(filter (isManaged typeEnv) (map snd memberPairs))
|
||||
(filter (isManaged typeEnv env) (map snd memberPairs))
|
||||
)
|
||||
genericCopy _ _ _ = error "genericcopy"
|
||||
|
@ -6,6 +6,7 @@ module Interfaces
|
||||
( registerInInterfaceIfNeeded,
|
||||
registerInInterface,
|
||||
retroactivelyRegisterInInterface,
|
||||
interfaceImplementedForTy,
|
||||
)
|
||||
where
|
||||
|
||||
@ -15,6 +16,7 @@ import Control.Monad (foldM)
|
||||
import Env
|
||||
import Lookup
|
||||
import Obj
|
||||
import Data.Maybe (mapMaybe)
|
||||
import Types
|
||||
import Util
|
||||
|
||||
@ -98,3 +100,14 @@ retroactivelyRegisterInInterface ctx interface =
|
||||
env = contextGlobalEnv ctx
|
||||
impls = lookupMany Everywhere lookupImplementations (getPath (binderXObj interface)) env
|
||||
resultCtx = foldM (\context binder -> registerInInterface context binder interface) ctx impls
|
||||
|
||||
-- | Checks whether an interface is implemented for a certain type signature,
|
||||
-- | e.g. Is "delete" implemented for `(Fn [String] ())` ?
|
||||
interfaceImplementedForTy :: TypeEnv -> Env -> String -> Ty -> Bool
|
||||
interfaceImplementedForTy (TypeEnv typeEnv) globalEnv interfaceName matchingTy =
|
||||
case lookupBinder (SymPath [] interfaceName) typeEnv of
|
||||
Just (Binder _ (XObj (Lst (XObj (Interface _ paths) _ _ : _)) _ _)) ->
|
||||
let lookupType path = forceTy . binderXObj <$> lookupBinder path globalEnv
|
||||
matches = filter (areUnifiable matchingTy) (mapMaybe lookupType paths)
|
||||
in not . null $ matches
|
||||
_ -> False
|
||||
|
@ -1,34 +1,21 @@
|
||||
module Managed where
|
||||
|
||||
import Lookup
|
||||
import Interfaces
|
||||
import Obj
|
||||
import Types
|
||||
|
||||
-- | Find out if a type is "external", meaning it is not defined by the user
|
||||
-- in this program but instead imported from another C library or similar.
|
||||
-- NOTE: Quite possibly this function should be removed and we should rely on 'isManaged' instead?
|
||||
isExternalType :: TypeEnv -> Ty -> Bool
|
||||
isExternalType typeEnv (PointerTy p) =
|
||||
isExternalType typeEnv p
|
||||
isExternalType typeEnv (StructTy (ConcreteNameTy name) _) =
|
||||
case lookupBinder (SymPath [] name) (getTypeEnv typeEnv) of
|
||||
Just (Binder _ (XObj (Lst (XObj (ExternalType _) _ _ : _)) _ _)) -> True
|
||||
_ -> False
|
||||
isExternalType _ _ =
|
||||
-- | Should this type be handled by the memory management system.
|
||||
-- Implementation note: This top-level pattern match should be able to just
|
||||
-- match on all types and see whether they implement 'delete', but for some
|
||||
-- reson that doesn't work. Might need to handle generic types separately?
|
||||
isManaged :: TypeEnv -> Env -> Ty -> Bool
|
||||
isManaged typeEnv globalEnv structTy@StructTy {} =
|
||||
interfaceImplementedForTy typeEnv globalEnv "delete" (FuncTy [structTy] UnitTy StaticLifetimeTy)
|
||||
isManaged typeEnv globalEnv funcTy@FuncTy {} =
|
||||
interfaceImplementedForTy typeEnv globalEnv "delete" (FuncTy [funcTy] UnitTy StaticLifetimeTy)
|
||||
isManaged _ _ StringTy =
|
||||
True
|
||||
isManaged _ _ PatternTy =
|
||||
True
|
||||
isManaged _ _ _ =
|
||||
False
|
||||
|
||||
-- | Is this type managed - does it need to be freed?
|
||||
isManaged :: TypeEnv -> Ty -> Bool
|
||||
isManaged typeEnv (StructTy (ConcreteNameTy name) _) =
|
||||
(name == "Array") || (name == "StaticArray") || (name == "Dictionary")
|
||||
|| ( case lookupBinder (SymPath [] name) (getTypeEnv typeEnv) of
|
||||
Just (Binder _ (XObj (Lst (XObj (ExternalType _) _ _ : _)) _ _)) -> False
|
||||
Just (Binder _ (XObj (Lst (XObj (Deftype _) _ _ : _)) _ _)) -> True
|
||||
Just (Binder _ (XObj (Lst (XObj (DefSumtype _) _ _ : _)) _ _)) -> True
|
||||
Just (Binder _ (XObj wrong _ _)) -> error ("Invalid XObj in type env: " ++ show wrong)
|
||||
Nothing -> error ("Can't find " ++ name ++ " in type env.") -- TODO: Please don't crash here!
|
||||
)
|
||||
isManaged _ StringTy = True
|
||||
isManaged _ PatternTy = True
|
||||
isManaged _ FuncTy {} = True
|
||||
isManaged _ _ = False
|
||||
|
@ -16,6 +16,7 @@ import Infer
|
||||
import Info
|
||||
import Interfaces
|
||||
import Lookup
|
||||
import Managed
|
||||
import qualified Meta as Meta
|
||||
import Obj
|
||||
import PrimitiveError
|
||||
@ -650,17 +651,22 @@ primitiveDeftype xobj ctx (name : rest) =
|
||||
in do
|
||||
ctxWithDeps <- liftIO (foldM (define True) ctx' deps)
|
||||
let fakeImplBinder sympath t = (Binder emptyMeta (XObj (Sym sympath Symbol) (Just dummyInfo) (Just t)))
|
||||
deleteSig = FuncTy [structTy] UnitTy StaticLifetimeTy
|
||||
strSig = FuncTy [RefTy structTy (VarTy "q")] StringTy StaticLifetimeTy
|
||||
copySig = FuncTy [RefTy structTy (VarTy "q")] structTy StaticLifetimeTy
|
||||
Just deleteInterface = lookupBinder (SymPath [] "delete") (getTypeEnv typeEnv)
|
||||
Just strInterface = lookupBinder (SymPath [] "str") (getTypeEnv typeEnv)
|
||||
Just copyInterface = lookupBinder (SymPath [] "copy") (getTypeEnv typeEnv)
|
||||
modulePath = SymPath (pathStrings ++ [typeModuleName])
|
||||
ctxWithInterfaceRegistrations =
|
||||
-- Since these functions are autogenerated, we treat them as a special case and automatically implement the interfaces.
|
||||
-- Since these functions are autogenerated, we treat them as a special case
|
||||
-- and automatically implement the interfaces.
|
||||
foldM
|
||||
(\context (path, sig, interface) -> registerInInterfaceIfNeeded context path interface sig)
|
||||
ctxWithDeps
|
||||
[ ((fakeImplBinder (SymPath (pathStrings ++ [typeModuleName]) "str") strSig), strSig, strInterface),
|
||||
((fakeImplBinder (SymPath (pathStrings ++ [typeModuleName]) "copy") copySig), copySig, copyInterface)
|
||||
[ (fakeImplBinder (modulePath "delete") deleteSig, deleteSig, deleteInterface),
|
||||
(fakeImplBinder (modulePath "str") strSig, strSig, strInterface),
|
||||
(fakeImplBinder (modulePath "copy") copySig, copySig, copyInterface)
|
||||
]
|
||||
case ctxWithInterfaceRegistrations of
|
||||
Left err -> do
|
||||
@ -895,3 +901,18 @@ openBrowserHelper ctx url =
|
||||
liftIO $ do
|
||||
_ <- openBrowser url
|
||||
return (ctx, dynamicNil)
|
||||
|
||||
-- | Checks if a type is managed. Note that it probably could be implemented in terms
|
||||
-- of `(implements? <sym>)` but to be 100% sure that we use the same lookup as the
|
||||
-- type system, I've done it this way -- at least for now.
|
||||
primitiveIsManaged :: Primitive
|
||||
primitiveIsManaged _ ctx [xobj@(XObj (Sym _ _) i _)] =
|
||||
let tenv = contextTypeEnv ctx
|
||||
genv = contextEnv ctx
|
||||
in case xobjToTy xobj of
|
||||
Just ty ->
|
||||
if isManaged tenv genv ty
|
||||
then pure (ctx, Right trueXObj)
|
||||
else pure (ctx, Right falseXObj)
|
||||
Nothing -> pure (evalError ctx ("Can't take type of " ++ pretty xobj) i)
|
||||
primitiveIsManaged _ _ _ = error "primitiveIsManaged"
|
||||
|
@ -293,6 +293,7 @@ dynamicModule =
|
||||
makeVarPrim "line" "returns the line a symbol was defined on." "(line mysymbol)" primitiveLine,
|
||||
makeVarPrim "column" "returns the column a symbol was defined on." "(column mysymbol)" primitiveColumn,
|
||||
makePrim "info" 1 "prints all information associated with a symbol." "(info mysymbol)" primitiveInfo,
|
||||
makePrim "managed?" 1 "" "" primitiveIsManaged,
|
||||
makeVarPrim "register-type" "registers a new type from C." "(register-type Name <optional: c-name> <optional: members>)" primitiveRegisterType,
|
||||
makePrim "defmacro" 3 "defines a new macro." "(defmacro name [args :rest restargs] body)" primitiveDefmacro,
|
||||
makePrim "defndynamic" 3 "defines a new dynamic function, i.e. a function available at compile time." "(defndynamic name [args] body)" primitiveDefndynamic,
|
||||
@ -458,6 +459,11 @@ startingTypeEnv =
|
||||
bindings =
|
||||
Map.fromList
|
||||
[ interfaceBinder
|
||||
"delete"
|
||||
(FuncTy [VarTy "a"] UnitTy StaticLifetimeTy)
|
||||
([SymPath ["Array"] "delete", SymPath ["StaticArray"] "delete"] ++ registerFunctionFunctionsWithInterface "delete")
|
||||
builtInSymbolInfo,
|
||||
interfaceBinder
|
||||
"copy"
|
||||
(FuncTy [RefTy (VarTy "a") (VarTy "q")] (VarTy "a") StaticLifetimeTy)
|
||||
([SymPath ["Array"] "copy", SymPath ["Pointer"] "copy"] ++ registerFunctionFunctionsWithInterface "copy")
|
||||
|
@ -1,19 +1,33 @@
|
||||
module StructUtils where
|
||||
|
||||
import Managed
|
||||
import Interfaces
|
||||
import Obj
|
||||
import Polymorphism
|
||||
import Types
|
||||
|
||||
memberInfo :: TypeEnv -> Ty -> (Ty, String, Ty)
|
||||
memberInfo typeEnv memberTy =
|
||||
let refOrNotRefType = if isManaged typeEnv memberTy then RefTy memberTy (VarTy "w") else memberTy -- OBS! The VarTy "w" here is dubious
|
||||
in (refOrNotRefType, if isManaged typeEnv memberTy then "&" else "", FuncTy [refOrNotRefType] StringTy StaticLifetimeTy)
|
||||
-- | The 'str'/'prn' functions for primitive types don't take refs, while other types do
|
||||
-- so we need to adjust for that when finding and calling them in compound types.
|
||||
-- The returned tuple contains ("" || "&", `str function type`).
|
||||
memberStrCallingConvention :: String -> TypeEnv -> Env -> Ty -> (String, Ty)
|
||||
memberStrCallingConvention strOrPrn typeEnv globalEnv memberTy =
|
||||
if callWithValue
|
||||
then ("", withValueSig)
|
||||
else ("&", withRefSig)
|
||||
where
|
||||
withValueSig = FuncTy [memberTy] StringTy StaticLifetimeTy
|
||||
withRefSig = FuncTy [RefTy memberTy (VarTy "w")] StringTy StaticLifetimeTy -- "w" here is dubious?
|
||||
callWithValue =
|
||||
-- If these interfaces are not implemented we assume ref signature is fine.
|
||||
-- Blitable is required to not accicentally pass a value owned by the struct to
|
||||
-- a non-ref str/prn function implemented on one of its memeber types.
|
||||
let blitable = interfaceImplementedForTy typeEnv globalEnv "blit" (FuncTy [memberTy] memberTy StaticLifetimeTy)
|
||||
strTakesValue = interfaceImplementedForTy typeEnv globalEnv strOrPrn withValueSig
|
||||
in blitable && strTakesValue
|
||||
|
||||
-- | Generate C code for converting a member variable to a string and appending it to a buffer.
|
||||
memberPrn :: TypeEnv -> Env -> (String, Ty) -> String
|
||||
memberPrn typeEnv env (memberName, memberTy) =
|
||||
let (_, maybeTakeAddress, strFuncType) = memberInfo typeEnv memberTy
|
||||
let (prefix, strFuncType) = memberStrCallingConvention "prn" typeEnv env memberTy
|
||||
in case nameOfPolymorphicFunction typeEnv env strFuncType "prn" of
|
||||
Just strFunctionPath ->
|
||||
case strFuncType of
|
||||
@ -26,27 +40,18 @@ memberPrn typeEnv env (memberName, memberTy) =
|
||||
]
|
||||
_ ->
|
||||
unlines
|
||||
[ " temp = " ++ pathToC strFunctionPath ++ "(" ++ maybeTakeAddress ++ "p->" ++ memberName ++ ");",
|
||||
[ " temp = " ++ pathToC strFunctionPath ++ "(" ++ prefix ++ "p->" ++ memberName ++ ");",
|
||||
" sprintf(bufferPtr, \"%s \", temp);",
|
||||
" bufferPtr += strlen(temp) + 1;",
|
||||
" if(temp) { CARP_FREE(temp); temp = NULL; }"
|
||||
]
|
||||
Nothing ->
|
||||
if isExternalType typeEnv memberTy
|
||||
then
|
||||
unlines
|
||||
[ " temp = malloc(11);",
|
||||
" sprintf(temp, \"<external>\");",
|
||||
" sprintf(bufferPtr, \"%s \", temp);",
|
||||
" bufferPtr += strlen(temp) + 1;",
|
||||
" if(temp) { CARP_FREE(temp); temp = NULL; }"
|
||||
]
|
||||
else " // Failed to find str function for " ++ memberName ++ " : " ++ show memberTy ++ "\n"
|
||||
" // Failed to find str function for " ++ memberName ++ " : " ++ show memberTy ++ "\n"
|
||||
|
||||
-- | Calculate the size for prn:ing a member of a struct
|
||||
memberPrnSize :: TypeEnv -> Env -> (String, Ty) -> String
|
||||
memberPrnSize typeEnv env (memberName, memberTy) =
|
||||
let (_, maybeTakeAddress, strFuncType) = memberInfo typeEnv memberTy
|
||||
let (prefix, strFuncType) = memberStrCallingConvention "prn" typeEnv env memberTy
|
||||
in case nameOfPolymorphicFunction typeEnv env strFuncType "prn" of
|
||||
Just strFunctionPath ->
|
||||
case strFuncType of
|
||||
@ -58,15 +63,9 @@ memberPrnSize typeEnv env (memberName, memberTy) =
|
||||
]
|
||||
_ ->
|
||||
unlines
|
||||
[ " temp = " ++ pathToC strFunctionPath ++ "(" ++ maybeTakeAddress ++ "p->" ++ memberName ++ "); ",
|
||||
[ " temp = " ++ pathToC strFunctionPath ++ "(" ++ prefix ++ "p->" ++ memberName ++ "); ",
|
||||
" size += snprintf(NULL, 0, \"%s \", temp);",
|
||||
" if(temp) { CARP_FREE(temp); temp = NULL; }"
|
||||
]
|
||||
Nothing ->
|
||||
if isExternalType typeEnv memberTy
|
||||
then
|
||||
unlines
|
||||
[ " size += 11;",
|
||||
" if(temp) { CARP_FREE(temp); temp = NULL; }"
|
||||
]
|
||||
else " // Failed to find str function for " ++ memberName ++ " : " ++ show memberTy ++ "\n"
|
||||
" // Failed to find str function for " ++ memberName ++ " : " ++ show memberTy ++ "\n"
|
||||
|
@ -172,8 +172,8 @@ concreteStr typeEnv env insidePath concreteStructTy@(StructTy (ConcreteNameTy ty
|
||||
)
|
||||
( \(FuncTy [RefTy (StructTy _ _) _] StringTy _) ->
|
||||
concatMap
|
||||
(depsOfPolymorphicFunction typeEnv env [] "prn" . typesStrFunctionType typeEnv)
|
||||
(filter (\t -> (not . isExternalType typeEnv) t && (not . isFullyGenericType) t) (concatMap caseTys cases))
|
||||
(depsOfPolymorphicFunction typeEnv env [] "prn" . typesStrFunctionType typeEnv env)
|
||||
(remove isFullyGenericType (concatMap caseTys cases))
|
||||
)
|
||||
concreteStr _ _ _ _ _ _ = error "concretestr"
|
||||
|
||||
@ -200,8 +200,8 @@ genericStr insidePath originalStructTy@(StructTy (ConcreteNameTy typeName) _) ca
|
||||
( \ft@(FuncTy [RefTy concreteStructTy@(StructTy _ _) _] StringTy _) ->
|
||||
let mappings = unifySignatures originalStructTy concreteStructTy
|
||||
correctedCases = replaceGenericTypesOnCases mappings cases
|
||||
tys = filter (\t' -> (not . isExternalType typeEnv) t' && (not . isFullyGenericType) t') (concatMap caseTys correctedCases)
|
||||
in concatMap (depsOfPolymorphicFunction typeEnv env [] "prn" . typesStrFunctionType typeEnv) tys
|
||||
tys = remove isFullyGenericType (concatMap caseTys correctedCases)
|
||||
in concatMap (depsOfPolymorphicFunction typeEnv env [] "prn" . typesStrFunctionType typeEnv env) tys
|
||||
++ (if isTypeGeneric concreteStructTy then [] else [defineFunctionTypeAlias ft])
|
||||
)
|
||||
genericStr _ _ _ _ = error "genericstr"
|
||||
@ -302,7 +302,7 @@ genericSumtypeDelete pathStrings originalStructTy cases =
|
||||
else
|
||||
concatMap
|
||||
(depsOfPolymorphicFunction typeEnv env [] "delete" . typesDeleterFunctionType)
|
||||
(filter (isManaged typeEnv) (concatMap caseTys correctedCases))
|
||||
(filter (isManaged typeEnv env) (concatMap caseTys correctedCases))
|
||||
)
|
||||
|
||||
-- | The template for the 'delete' function of a concrete sumtype
|
||||
@ -327,7 +327,7 @@ concreteSumtypeDelete insidePath typeEnv env structTy@(StructTy (ConcreteNameTy
|
||||
( \_ ->
|
||||
concatMap
|
||||
(depsOfPolymorphicFunction typeEnv env [] "delete" . typesDeleterFunctionType)
|
||||
(filter (isManaged typeEnv) (concatMap caseTys cases))
|
||||
(filter (isManaged typeEnv env) (concatMap caseTys cases))
|
||||
)
|
||||
concreteSumtypeDelete _ _ _ _ _ = error "concretesumtypedelete"
|
||||
|
||||
@ -376,7 +376,7 @@ genericSumtypeCopy pathStrings originalStructTy cases =
|
||||
else
|
||||
concatMap
|
||||
(depsOfPolymorphicFunction typeEnv env [] "copy" . typesCopyFunctionType)
|
||||
(filter (isManaged typeEnv) (concatMap caseTys correctedCases))
|
||||
(filter (isManaged typeEnv env) (concatMap caseTys correctedCases))
|
||||
)
|
||||
|
||||
-- | The template for the 'copy' function of a concrete sumtype
|
||||
@ -393,7 +393,7 @@ concreteSumtypeCopy insidePath typeEnv env structTy@(StructTy (ConcreteNameTy ty
|
||||
( \_ ->
|
||||
concatMap
|
||||
(depsOfPolymorphicFunction typeEnv env [] "copy" . typesCopyFunctionType)
|
||||
(filter (isManaged typeEnv) (concatMap caseTys cases))
|
||||
(filter (isManaged typeEnv env) (concatMap caseTys cases))
|
||||
)
|
||||
concreteSumtypeCopy _ _ _ _ _ = error "concretesumtypecopy"
|
||||
|
||||
|
@ -5,7 +5,6 @@ import Data.Function (on)
|
||||
import Data.List (nubBy, (\\))
|
||||
import Data.Maybe (fromJust)
|
||||
import Lookup
|
||||
import Managed
|
||||
import Obj
|
||||
import TypeError
|
||||
import TypePredicates
|
||||
@ -66,45 +65,43 @@ okXObjForType typeEnv typeVariables xobj =
|
||||
-- | Can this type be used as a member for a deftype?
|
||||
canBeUsedAsMemberType :: TypeEnv -> [Ty] -> Ty -> XObj -> Either TypeError ()
|
||||
canBeUsedAsMemberType typeEnv typeVariables ty xobj =
|
||||
if isExternalType typeEnv ty
|
||||
then pure ()
|
||||
else case ty of
|
||||
UnitTy -> pure ()
|
||||
IntTy -> pure ()
|
||||
FloatTy -> pure ()
|
||||
DoubleTy -> pure ()
|
||||
ByteTy -> pure ()
|
||||
LongTy -> pure ()
|
||||
BoolTy -> pure ()
|
||||
StringTy -> pure ()
|
||||
PatternTy -> pure ()
|
||||
CharTy -> pure ()
|
||||
FuncTy {} -> pure ()
|
||||
PointerTy UnitTy -> pure ()
|
||||
PointerTy inner ->
|
||||
canBeUsedAsMemberType typeEnv typeVariables inner xobj
|
||||
>> pure ()
|
||||
-- Struct variables may appear as complete applications or individual
|
||||
-- components in the head of a definition; that is the forms:
|
||||
-- ((Foo (f a b)) [x (f a b)])
|
||||
-- ((Foo f a b) [x f y a z b])
|
||||
-- are both valid, but restrict their types differently. In the former,
|
||||
-- `f` may only appear in complete applications over `a` and `b`, in
|
||||
-- other words, `f` is closed over `a` and `b`. In the latter, f may
|
||||
-- flexibly be used as a type variable of nullary kind, or as a type
|
||||
-- variable of unary kind `(Foo f a b) [x (f a) y (f b)])` so long as
|
||||
-- the kinds of each occasion of `f` are consistent.
|
||||
--
|
||||
-- Likewise, the types denoted by:
|
||||
-- ((Foo (f a) b) ...)
|
||||
-- and
|
||||
-- ((Foo (f a) (f b)) ...)
|
||||
-- differ.
|
||||
-- Attempt the first, more restrictive formulation first.
|
||||
struct@(StructTy name tyVars) ->
|
||||
checkVar struct <> checkStruct name tyVars
|
||||
v@(VarTy _) -> checkVar v
|
||||
_ -> Left (InvalidMemberType ty xobj)
|
||||
case ty of
|
||||
UnitTy -> pure ()
|
||||
IntTy -> pure ()
|
||||
FloatTy -> pure ()
|
||||
DoubleTy -> pure ()
|
||||
ByteTy -> pure ()
|
||||
LongTy -> pure ()
|
||||
BoolTy -> pure ()
|
||||
StringTy -> pure ()
|
||||
PatternTy -> pure ()
|
||||
CharTy -> pure ()
|
||||
FuncTy {} -> pure ()
|
||||
PointerTy UnitTy -> pure ()
|
||||
PointerTy inner ->
|
||||
canBeUsedAsMemberType typeEnv typeVariables inner xobj
|
||||
>> pure ()
|
||||
-- Struct variables may appear as complete applications or individual
|
||||
-- components in the head of a definition; that is the forms:
|
||||
-- ((Foo (f a b)) [x (f a b)])
|
||||
-- ((Foo f a b) [x f y a z b])
|
||||
-- are both valid, but restrict their types differently. In the former,
|
||||
-- `f` may only appear in complete applications over `a` and `b`, in
|
||||
-- other words, `f` is closed over `a` and `b`. In the latter, f may
|
||||
-- flexibly be used as a type variable of nullary kind, or as a type
|
||||
-- variable of unary kind `(Foo f a b) [x (f a) y (f b)])` so long as
|
||||
-- the kinds of each occasion of `f` are consistent.
|
||||
--
|
||||
-- Likewise, the types denoted by:
|
||||
-- ((Foo (f a) b) ...)
|
||||
-- and
|
||||
-- ((Foo (f a) (f b)) ...)
|
||||
-- differ.
|
||||
-- Attempt the first, more restrictive formulation first.
|
||||
struct@(StructTy name tyVars) ->
|
||||
checkVar struct <> checkStruct name tyVars
|
||||
v@(VarTy _) -> checkVar v
|
||||
_ -> Left (InvalidMemberType ty xobj)
|
||||
where
|
||||
checkStruct :: Ty -> [Ty] -> Either TypeError ()
|
||||
checkStruct (ConcreteNameTy "Array") [innerType] =
|
||||
@ -112,6 +109,8 @@ canBeUsedAsMemberType typeEnv typeVariables ty xobj =
|
||||
>> pure ()
|
||||
checkStruct (ConcreteNameTy n) vars =
|
||||
case lookupBinder (SymPath [] n) (getTypeEnv typeEnv) of
|
||||
Just (Binder _ (XObj (Lst (XObj (ExternalType _) _ _ : _)) _ _)) ->
|
||||
pure ()
|
||||
Just (Binder _ (XObj (Lst (XObj (Deftype t) _ _ : _)) _ _)) ->
|
||||
checkInhabitants t >> foldM (\_ typ -> canBeUsedAsMemberType typeEnv typeVariables typ xobj) () vars
|
||||
Just (Binder _ (XObj (Lst (XObj (DefSumtype t) _ _ : _)) _ _)) ->
|
||||
|
@ -7,5 +7,6 @@
|
||||
;; The one allocation left after 'carp_init_globals' should be 'g' itself:
|
||||
(defn main []
|
||||
(do
|
||||
(Debug.log-memory-balance! true)
|
||||
(assert (= 1l (Debug.memory-balance)))
|
||||
0))
|
||||
|
66
test/managed.carp
Normal file
66
test/managed.carp
Normal file
@ -0,0 +1,66 @@
|
||||
(load-and-use Test)
|
||||
|
||||
(defn assert-memory-balance [state f expected-balance descr]
|
||||
(do
|
||||
(Debug.reset-memory-balance!)
|
||||
(f)
|
||||
(assert-equal state expected-balance (Debug.memory-balance) descr)))
|
||||
|
||||
(register-type A "void*")
|
||||
(register-type B "void*")
|
||||
|
||||
(defmodule A
|
||||
(deftemplate init (Fn [] A)
|
||||
"void* $NAME()" "$DECL { return CARP_MALLOC(128); }")
|
||||
|
||||
(deftemplate copy (Fn [&A] A)
|
||||
"void* $NAME(void **p)" "$DECL { return CARP_MALLOC(128); }")
|
||||
(implements copy A.copy)
|
||||
|
||||
(deftemplate delete (Fn [A] ())
|
||||
"void $NAME(void *p)" "$DECL { CARP_FREE(p); }")
|
||||
(implements delete A.delete))
|
||||
|
||||
(defmodule B
|
||||
(deftemplate init (Fn [] B)
|
||||
"void* $NAME()" "$DECL { return CARP_MALLOC(128); }")
|
||||
|
||||
(deftemplate copy (Fn [&B] B)
|
||||
"void* $NAME(void **p)" "$DECL { return CARP_MALLOC(128); }")
|
||||
(implements copy B.copy)
|
||||
|
||||
;; 'B' does *not* implement delete!
|
||||
;; The user would have to call delete / free on it manually to avoid a leak.
|
||||
)
|
||||
|
||||
(defn f-a []
|
||||
(let [a (A)]
|
||||
()))
|
||||
|
||||
(defn f-b []
|
||||
(let [b (B)]
|
||||
()))
|
||||
|
||||
(defn f-copy-a []
|
||||
(let [a (A)
|
||||
a2 @&a]
|
||||
()))
|
||||
|
||||
(defn f-copy-b []
|
||||
(let [b (B)
|
||||
b2 @&b]
|
||||
()))
|
||||
|
||||
(eval ;; temporary workaround to force evaluation of top-level 'when'
|
||||
(when (not (managed? A))
|
||||
(macro-error "Fail - A should be managed.")))
|
||||
|
||||
(eval
|
||||
(when (managed? B)
|
||||
(macro-error "Fail - B should not be managed.")))
|
||||
|
||||
(deftest test
|
||||
(assert-memory-balance test f-a 0l "f-a correct, does not leak")
|
||||
(assert-memory-balance test f-b 1l "f-b correct, leaks 1 value")
|
||||
(assert-memory-balance test f-copy-a 0l "f-copy-a correct, does not leak")
|
||||
(assert-memory-balance test f-copy-b 2l "f-copy-b correct, leaks 2 values"))
|
@ -4,7 +4,7 @@
|
||||
(use-all Double Test Statistics)
|
||||
|
||||
(defn all-eq [a b]
|
||||
(if (Int./= (Array.length a) (Array.length b))
|
||||
(if (/= (Array.length a) (Array.length b))
|
||||
false
|
||||
(let [res true]
|
||||
(do
|
||||
@ -15,7 +15,7 @@
|
||||
res))))
|
||||
|
||||
(defn all-approx [a b]
|
||||
(if (Int./= (Array.length a) (Array.length b))
|
||||
(if (/= (Array.length a) (Array.length b))
|
||||
false
|
||||
(let [res true]
|
||||
(do
|
||||
|
Loading…
Reference in New Issue
Block a user