BIG CHANGE: Functions are managed now.

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)
+                summ (get-samples @&f n)  ;; @& HACK, TODO: Should be able to pass the ref instead
-                summ5 (get-samples f n)
+                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)

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))
 )
-

examples/temp.carp

@@ -23,10 +23,19 @@
 ;;   (let [g (f 10)]
 ;;     (println* (g 1))))
 
-(use Array)
+;; (use Array)
 
-(defn pow-to [exponent]
+;; (defn pow-to [exponent]
-  (endo-map (fn [x] (Int.pow x exponent)) (range 0 10 1)))
+;;   (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)))

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

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?

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 ++ " <interface>"
             Bol b -> if b then "true" else "false"
             Defn -> "defn"
             Def -> "def"

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
+    bindings = Map.fromList [ generateTemplateFuncCopy funcTy
-                            ,generateTemplateFuncStrOrPrn "str" funcTy
+                            , generateTemplateFuncDelete funcTy
-                            ,generateTemplateFuncStrOrPrn "prn" 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)
+  (SymPath ["Function"] name)
-  (FuncTy [funcTy] StringTy)
+  (FuncTy [(RefTy funcTy)] StringTy)
-  (toTemplate "String $NAME (Lambda f)")
+  (toTemplate "String $NAME (Lambda *f)")
   (toTemplate $ unlines ["$DECL {"
                         ,"    static String lambda = \"λ\";"
                         ,"    return String_copy(&lambda);"