carp-lang/Carp
1
1
Fork 0
mirror of https://github.com/carp-lang/Carp.git synced 2024-10-11 20:49:05 +03:00
Code Issues Projects Releases Wiki Activity

Got rid of special "insideArrayDeps" functions that were just duplication.

Browse Source
This commit is contained in:
Erik Svedäng 2017-09-01 16:57:09 +02:00
parent f7cf23dd46
commit 27d0baefba
5 changed files with 48 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
examples/deleters.carp Normal file
View File

@ -0,0 +1,10 @@
(import IO)
(import Int)
(import String)
(import Array)
(deftype A [s String])
(defn f []
(let [stuff [(A.init "hej") (A.init "svej")]]
123))

59
src/Concretize.hs
View File

@ -30,7 +30,7 @@ concretizeXObj allowAmbiguity typeEnv rootEnv root =
return $ do okVisited <- visited
Right (XObj (Lst okVisited) i t)
visit env (XObj (Arr arr) i (Just t)) = do visited <- fmap sequence (mapM (visit env) arr)
modify ((insideArrayDeleteDeps typeEnv env t) ++ )
modify ((deleterDeps typeEnv env t) ++ )
modify ((defineArrayTypeAlias t) : )
return $ do okVisited <- visited
Right (XObj (Arr okVisited) i (Just t))
@ -163,47 +163,36 @@ concretizeDefinition allowAmbiguity typeEnv globalEnv definition concreteType =
err ->
compilerError ("Can't concretize " ++ show err ++ ": " ++ pretty definition)
allFunctionsWithNameAndSignature env functionName functionType =
filter (predicate . ty . binderXObj . snd) (multiLookupALL functionName env)
where
predicate = \(Just t) -> areUnifiable functionType t
-- | Find all the dependencies of a polymorphic function with a name and a desired concrete type.
depsOfPolymorphicFunction :: Env -> Env -> String -> Ty -> [XObj]
depsOfPolymorphicFunction typeEnv env functionName functionType =
case filter ((\(Just t') -> (areUnifiable functionType t')) . ty . binderXObj . snd) (multiLookupALL functionName env) of
[] -> (trace $ "No '" ++ functionName ++ "' function found for type " ++ show functionType ++ ".") []
case allFunctionsWithNameAndSignature env functionName functionType of
[] ->
(trace $ "No '" ++ functionName ++ "' function found with type " ++ show functionType ++ ".")
[]
[(_, Binder (XObj (Lst ((XObj (Instantiate _) _ _) : _)) _ _))] ->
[]
[(_, Binder single)] ->
case concretizeDefinition False typeEnv env single functionType of
Left err -> error (show err)
Right (ok, deps) -> (ok : deps)
_ -> (trace $ "Too many '" ++ functionName ++ "' functions found, can't figure out dependencies.") []
_ ->
(trace $ "Too many '" ++ functionName ++ "' functions found with type " ++ show functionType ++ ", can't figure out dependencies.")
[]
deleterDeps :: Env -> Env -> Ty -> [XObj]
deleterDeps typeEnv env t =
if isManaged t
then depsOfPolymorphicFunction typeEnv env "delete" (FuncTy [t] UnitTy)
else []
-- | TODO: Can this use the 'depsOfPolymorphicFunction' too?!
insideArrayDeleteDeps :: Env -> Env -> Ty -> [XObj]
insideArrayDeleteDeps typeEnv env t
| isManaged t =
case filter ((\(Just t') -> (areUnifiable (FuncTy [t] UnitTy) t')) . ty . binderXObj . snd) (multiLookupALL "delete" env) of
[] -> --(trace $ "No 'delete' function found for " ++ show t)
[]
[(_, Binder (XObj (Lst ((XObj (Instantiate _) _ _) : _)) _ _))] ->
[]
[(_, Binder single)] ->
case concretizeDefinition False typeEnv env single (FuncTy [t] (UnitTy)) of
Left err -> error (show err)
Right (ok, deps) -> (ok : deps)
_ -> (trace $ "Too many 'delete' functions found for " ++ show t) []
| otherwise = []
-- | TODO: merge with "insideArrayDeleteDeps" etc.
insideArrayCopyDeps :: Env -> Env -> Ty -> [XObj]
insideArrayCopyDeps typeEnv env t
| isManaged t =
case filter ((\(Just t') -> (areUnifiable (FuncTy [(RefTy t)] t) t')) . ty . binderXObj . snd) (multiLookupALL "copy" env) of
[] -> --(trace $ "No 'copy' function found for " ++ show t)
[]
[(_, Binder (XObj (Lst ((XObj (Instantiate _) _ _) : _)) _ _))] ->
[]
[(_, Binder single)] ->
case concretizeDefinition False typeEnv env single (FuncTy [(RefTy t)] t) of
Left err -> error (show err)
Right (ok, deps) -> (ok : deps)
_ -> (trace $ "Too many 'copy' functions found for " ++ show t) []
| otherwise = []
copierDeps :: Env -> Env -> Ty -> [XObj]
copierDeps typeEnv env t =
if isManaged t
then depsOfPolymorphicFunction typeEnv env "copy" (FuncTy [(RefTy t)] t)
else []

2
src/Infer.hs
View File

@ -6,8 +6,6 @@ module Infer (annotate
,concretizeDefinition
,manageMemory
,depsOfPolymorphicFunction
,insideArrayDeleteDeps
,insideArrayCopyDeps
) where
import Control.Monad.State

18
src/Template.hs
View File

@ -12,6 +12,7 @@ import Types
import Obj
import Parsing
import Infer
import Concretize
-- | Templates are instructions for the compiler to generate some C-code
-- | based on some template and the names and types to fill into the template.
@ -161,7 +162,7 @@ templateCopyingMap = defineTypeParameterizedTemplate templateCreator path t
]))
(\(FuncTy [ft@(FuncTy [insideTypeA] _), arrayTypeA] arrayTypeB) ->
[defineFunctionTypeAlias ft, defineArrayTypeAlias arrayTypeA, defineArrayTypeAlias arrayTypeB] ++
insideArrayDeleteDeps typeEnv env insideTypeA)
deleterDeps typeEnv env insideTypeA)
-- | "Endofunctor Map"
templateEMap :: (String, Binder)
@ -213,7 +214,8 @@ templateFilter = defineTypeParameterizedTemplate templateCreator path t
, "}"
]))
(\(FuncTy [ft@(FuncTy [insideType] BoolTy), arrayType] _) ->
[defineFunctionTypeAlias ft, defineArrayTypeAlias arrayType] ++ insideArrayDeleteDeps typeEnv env insideType)
[defineFunctionTypeAlias ft, defineArrayTypeAlias arrayType] ++
deleterDeps typeEnv env insideType)
templateReduce :: (String, Binder)
templateReduce = defineTypeParameterizedTemplate templateCreator path t
@ -318,7 +320,8 @@ templateReplicate = defineTypeParameterizedTemplate templateCreator path t
, " return a;"
, "}"]))
(\(FuncTy [_, _] arrayType) ->
[defineArrayTypeAlias arrayType] ++ insideArrayDeleteDeps typeEnv env arrayType)
let StructTy _ [insideType] = arrayType
in [defineArrayTypeAlias arrayType] ++ deleterDeps typeEnv env insideType)
templateRepeat :: (String, Binder)
templateRepeat = defineTypeParameterizedTemplate templateCreator path t
@ -339,7 +342,9 @@ templateRepeat = defineTypeParameterizedTemplate templateCreator path t
, " return a;"
, "}"]))
(\(FuncTy [_, ft] arrayType) ->
defineArrayTypeAlias arrayType : defineFunctionTypeAlias ft : insideArrayDeleteDeps typeEnv env arrayType)
let StructTy _ [insideType] = arrayType
in defineArrayTypeAlias arrayType : defineFunctionTypeAlias ft :
deleterDeps typeEnv env insideType)
templateRaw :: (String, Binder)
templateRaw = defineTemplate
@ -411,7 +416,7 @@ templateDeleteArray = defineTypeParameterizedTemplate templateCreator path t
(deleteTy env arrayType) ++
[TokC "}\n"])
(\(FuncTy [arrayType@(StructTy "Array" [insideType])] UnitTy) ->
defineArrayTypeAlias arrayType : insideArrayDeleteDeps typeEnv env insideType)
defineArrayTypeAlias arrayType : deleterDeps typeEnv env insideType)
path = SymPath ["Array"] "delete"
t = (FuncTy [(StructTy "Array" [VarTy "a"])] UnitTy)
@ -471,7 +476,8 @@ templateCopyArray = defineTypeParameterizedTemplate templateCreator path t
[TokC "}\n"])
(\case
(FuncTy [(RefTy arrayType@(StructTy "Array" [insideType]))] _) ->
defineArrayTypeAlias arrayType : insideArrayCopyDeps typeEnv env insideType
defineArrayTypeAlias arrayType :
copierDeps typeEnv env insideType
err ->
error ("CAN'T MATCH: " ++ (show err))
)

3
src/Types.hs
View File

@ -15,6 +15,7 @@ module Types ( TypeMappings
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import Util
--import Debug.Trace
-- | Carp types.
data Ty = IntTy
@ -29,7 +30,7 @@ data Ty = IntTy
| ModuleTy
| PointerTy Ty
| RefTy Ty
| StructTy String [Ty]
| StructTy String [Ty] -- the name of the struct, and it's type parameters
| TypeTy -- the type of types
| MacroTy
| DynamicTy -- the type of dynamic functions (used in REPL and macros)