diff --git a/core/Bench.carp b/core/Bench.carp index 490d5839..08549b20 100644 --- a/core/Bench.carp +++ b/core/Bench.carp @@ -55,7 +55,7 @@ samples (Array.replicate min-runs &zero)] (do (for [i 0 min-runs] - (Array.aset! &samples i (Double./ (ns-iter-inner f (Double.to-int n)) n))) + (Array.aset! &samples i (Double./ (ns-iter-inner @&f (Double.to-int n)) n))) ;; TODO: Get rid of '@&' here. (Statistics.summary &(Statistics.winsorize &samples 5.0))))) (private min-one) @@ -67,7 +67,7 @@ ; long-running function, where long-running is everything over 30ms. (doc bench "Benchmark function f and print the results.") (defn bench [f] - (let [ns (ns-iter-inner f 1) + (let [ns (ns-iter-inner @&f 1) ;; @& HACK, TODO: Should be able to pass the ref instead ns-target-total 1000000.0 _n (Double./ ns-target-total (min-one ns)) n (min-one _n) @@ -77,8 +77,8 @@ (do (while (and (Double.< total 3000000000.0) (not done)) (let [loop-start (get-time-elapsed) - summ (get-samples f n) - summ5 (get-samples f n) + summ (get-samples @&f n) ;; @& HACK, TODO: Should be able to pass the ref instead + summ5 (get-samples @&f n) ;; @& HACK, TODO: Should be able to pass the ref instead loop-run (- (get-time-elapsed) loop-start)] (if (and (Double.> loop-run 100000.0) diff --git a/core/Heap.carp b/core/Heap.carp index 14919bb0..4353497e 100644 --- a/core/Heap.carp +++ b/core/Heap.carp @@ -1,4 +1,3 @@ - ; Abstract heap with user-supplied ordering function ; an ordering function is a binary relation ; `<` will create a MinHeap, `>` will create a MaxHeap @@ -34,7 +33,7 @@ (defn push-down-until! [heap i len ord] (while true - (let [challenger (max-of-three-until! heap i len ord)] + (let [challenger (max-of-three-until! heap i len @&ord)] ;; TODO: Added a "ref + copy" to silence borrow checker for 'ord', should not be needed..?! (if (= challenger i) (break) (do @@ -62,7 +61,7 @@ (defn heapify! [arr ord] (let [len (Array.length arr)] (for [i 1 len] - (push-up! arr i ord)))) + (push-up! arr i @&ord)))) ;; TODO: Added a "ref + copy" to silence borrow checker for 'ord', should not be needed..?! (doc push! "Insert a new item onto the heap.") (defn push! [heap item ord] @@ -175,4 +174,3 @@ (sort! &arr) arr)) ) - diff --git a/examples/temp.carp b/examples/temp.carp index b9ad799b..70477d8d 100644 --- a/examples/temp.carp +++ b/examples/temp.carp @@ -23,10 +23,19 @@ ;; (let [g (f 10)] ;; (println* (g 1)))) -(use Array) +;; (use Array) -(defn pow-to [exponent] - (endo-map (fn [x] (Int.pow x exponent)) (range 0 10 1))) +;; (defn pow-to [exponent] +;; (endo-map (fn [x] (Int.pow x exponent)) (range 0 10 1))) + +;; (defn main [] +;; (println* (ref (pow-to 3)))) + +(deftype Blah [function (Fn [] ())]) + +(defn hej [] (println* "hej")) (defn main [] - (println* (ref (pow-to 3)))) + (let [b (Blah.init hej) + f @(Blah.function &b)] + (f))) diff --git a/src/Concretize.hs b/src/Concretize.hs index b34d1539..89467ae2 100644 --- a/src/Concretize.hs +++ b/src/Concretize.hs @@ -845,7 +845,7 @@ manageMemory typeEnv globalEnv root = unmanage xobj = let Just t = ty xobj Just i = info xobj - in if isManaged typeEnv t && not (isExternalType typeEnv t) + in if isManaged typeEnv t && not (isGlobalFunc xobj) && not (isExternalType typeEnv t) then do MemState deleters deps <- get case deletersMatchingXObj xobj deleters of [] -> return (Left (UsingUnownedValue xobj)) @@ -863,7 +863,7 @@ manageMemory typeEnv globalEnv root = isGlobalVariable = case xobj of XObj (Sym _ (LookupGlobal _)) _ _ -> True _ -> False - in if not isGlobalVariable && isManaged typeEnv t && not (isExternalType typeEnv t) + in if not isGlobalVariable && not (isGlobalFunc xobj) && isManaged typeEnv t && not (isExternalType typeEnv t) then do MemState deleters deps <- get case deletersMatchingXObj xobj deleters of [] -> return (Left (GettingReferenceToUnownedValue xobj)) @@ -896,3 +896,12 @@ suffixTyVars suffix t = (PointerTy x) -> PointerTy (suffixTyVars suffix x) (RefTy x) -> RefTy (suffixTyVars suffix x) _ -> t + +isGlobalFunc :: XObj -> Bool +isGlobalFunc xobj = + case xobj of + XObj (InterfaceSym _) _ (Just (FuncTy _ _)) -> True + XObj (MultiSym _ _) _ (Just (FuncTy _ _)) -> True + XObj (Sym _ (LookupGlobal _)) _ (Just (FuncTy _ _)) -> True + XObj (Sym _ (LookupGlobalOverride _)) _ (Just (FuncTy _ _)) -> True + _ -> False diff --git a/src/Lookup.hs b/src/Lookup.hs index dd8de465..3e7ef10c 100644 --- a/src/Lookup.hs +++ b/src/Lookup.hs @@ -196,6 +196,7 @@ isManaged typeEnv (StructTy name _) = ) isManaged _ StringTy = True isManaged _ PatternTy = True +isManaged _ (FuncTy _ _) = True isManaged _ _ = False -- | Is this type a function type? diff --git a/src/Obj.hs b/src/Obj.hs index 4e35a54a..44f546c1 100644 --- a/src/Obj.hs +++ b/src/Obj.hs @@ -244,7 +244,7 @@ pretty = visit 0 Chr c -> '\\' : c : "" Sym path mode -> show path ++ " <" ++ show mode ++ ">" MultiSym originalName paths -> originalName ++ "{" ++ joinWithComma (map show paths) ++ "}" - InterfaceSym name -> name + InterfaceSym name -> name ++ " " Bol b -> if b then "true" else "false" Defn -> "defn" Def -> "def" diff --git a/src/StartingEnv.hs b/src/StartingEnv.hs index 670192e6..a5cb6bf0 100644 --- a/src/StartingEnv.hs +++ b/src/StartingEnv.hs @@ -124,16 +124,17 @@ generateInnerFunctionModule arity = alphabet = ['d'..'y'] charToTyName c = [c] funcTy = FuncTy (take arity (map (VarTy . charToTyName) alphabet)) (VarTy "z") - bindings = Map.fromList [generateTemplateFuncCopy funcTy - ,generateTemplateFuncStrOrPrn "str" funcTy - ,generateTemplateFuncStrOrPrn "prn" funcTy + bindings = Map.fromList [ generateTemplateFuncCopy funcTy + , generateTemplateFuncDelete funcTy + , generateTemplateFuncStrOrPrn "str" funcTy + , generateTemplateFuncStrOrPrn "prn" funcTy ] -- | A template function for generating 'copy' functions for function pointers. generateTemplateFuncCopy :: Ty -> (String, Binder) generateTemplateFuncCopy funcTy = defineTemplate - (SymPath [] "copy") + (SymPath ["Function"] "copy") (FuncTy [RefTy funcTy] (VarTy "a")) (toTemplate "$a $NAME ($a* ref)") (toTemplate $ unlines ["$DECL {" @@ -141,12 +142,25 @@ generateTemplateFuncCopy funcTy = defineTemplate ,"}"]) (const []) +-- | A template function for generating 'deleter' functions for function pointers. +generateTemplateFuncDelete :: Ty -> (String, Binder) +generateTemplateFuncDelete funcTy = defineTemplate + (SymPath ["Function"] "delete") + (FuncTy [funcTy] UnitTy) + (toTemplate "void $NAME (Lambda f)") + (toTemplate $ unlines ["$DECL {" + ," if(f.env) {" + ," /* delete env */ " + ," }" + ,"}"]) + (const []) + -- | A template function for generating 'str' or 'prn' functions for function pointers. generateTemplateFuncStrOrPrn :: String -> Ty -> (String, Binder) generateTemplateFuncStrOrPrn name funcTy = defineTemplate - (SymPath [] name) - (FuncTy [funcTy] StringTy) - (toTemplate "String $NAME (Lambda f)") + (SymPath ["Function"] name) + (FuncTy [(RefTy funcTy)] StringTy) + (toTemplate "String $NAME (Lambda *f)") (toTemplate $ unlines ["$DECL {" ," static String lambda = \"λ\";" ," return String_copy(&lambda);"