core: add pointer arithmetic (references #423)

core/Core.carp

@@ -33,6 +33,7 @@
 (load "System.carp")
 (load "Pattern.carp")
 (load "Debug.carp")
+(load "Pointer.carp")
 (load "Format.carp")
 (load "Random.carp")
 (load "Map.carp")

core/Pointer.carp

@@ -0,0 +1,4 @@
+(defmodule Pointer
+  (defn inc [a] (Pointer.add a 1l))
+  (defn dec [a] (Pointer.sub a 1l))
+)

src/StartingEnv.hs

@@ -52,7 +52,17 @@ pointerModule = Env { envBindings = bindings
                     , envUseModules = []
                     , envMode = ExternalEnv
                     , envFunctionNestingLevel = 0 }
-  where bindings = Map.fromList [ templatePointerCopy, templatePointerEqual, templatePointerToRef ]
+  where bindings = Map.fromList [ templatePointerCopy
+                                , templatePointerEqual
+                                , templatePointerToRef
+                                , templatePointerAdd
+                                , templatePointerSub
+                                , templatePointerMul
+                                , templatePointerDiv
+                                , templatePointerWidth
+                                , templatePointerToLong
+                                , templatePointerFromLong
+                                ]
 
 -- | A template function for copying (= deref:ing) any pointer.
 templatePointerCopy :: (String, Binder)
@@ -87,6 +97,76 @@ templatePointerToRef = defineTemplate
                         ,"}"])
   (const [])
 
+templatePointerAdd = defineTemplate
+  (SymPath ["Pointer"] "add")
+  (FuncTy [PointerTy (VarTy "p"), LongTy] (PointerTy (VarTy "p")))
+  "adds a long integer value to a pointer."
+  (toTemplate "$p* $NAME ($p *p, long x)")
+  (toTemplate $ unlines ["$DECL {"
+                        ,"    return p + x;"
+                        ,"}"])
+  (const [])
+
+templatePointerSub = defineTemplate
+  (SymPath ["Pointer"] "sub")
+  (FuncTy [PointerTy (VarTy "p"), LongTy] (PointerTy (VarTy "p")))
+  "subtracts a long integer value from a pointer."
+  (toTemplate "$p* $NAME ($p *p, long x)")
+  (toTemplate $ unlines ["$DECL {"
+                        ,"    return p - x;"
+                        ,"}"])
+  (const [])
+
+templatePointerMul = defineTemplate
+  (SymPath ["Pointer"] "mul")
+  (FuncTy [PointerTy (VarTy "p"), LongTy] (PointerTy (VarTy "p")))
+  "multiplies a pointer by a long integer."
+  (toTemplate "$p* $NAME ($p *p, long x)")
+  (toTemplate $ unlines ["$DECL {"
+                        ,"    return p * x;"
+                        ,"}"])
+  (const [])
+
+templatePointerDiv = defineTemplate
+  (SymPath ["Pointer"] "div")
+  (FuncTy [PointerTy (VarTy "p"), LongTy] (PointerTy (VarTy "p")))
+  "divides a pointer by a long integer."
+  (toTemplate "$p* $NAME ($p *p, long x)")
+  (toTemplate $ unlines ["$DECL {"
+                        ,"    return p / x;"
+                        ,"}"])
+  (const [])
+
+templatePointerWidth = defineTemplate
+  (SymPath ["Pointer"] "width")
+  (FuncTy [PointerTy (VarTy "p")] LongTy)
+  "gets the byte size of a pointer."
+  (toTemplate "long $NAME ($p *p)")
+  (toTemplate $ unlines ["$DECL {"
+                        ,"    return sizeof(*p);"
+                        ,"}"])
+  (const [])
+
+templatePointerToLong = defineTemplate
+  (SymPath ["Pointer"] "to-long")
+  (FuncTy [PointerTy (VarTy "p")] LongTy)
+  "converts a pointer to a long integer."
+  (toTemplate "long $NAME ($p *p)")
+  (toTemplate $ unlines ["$DECL {"
+                        ,"    return (long)p;"
+                        ,"}"])
+  (const [])
+
+templatePointerFromLong = defineTemplate
+  (SymPath ["Pointer"] "from-int")
+  (FuncTy [LongTy] (PointerTy (VarTy "p")))
+  "converts a long integer to a pointer."
+  (toTemplate "$p* $NAME (long p)")
+  (toTemplate $ unlines ["$DECL {"
+                        ,"    return ($p*)p;"
+                        ,"}"])
+  (const [])
+
 -- | The System module contains functions for various OS related things like timing and process control.
 systemModule :: Env
 systemModule = Env { envBindings = bindings
@@ -97,6 +177,7 @@ systemModule = Env { envBindings = bindings
                    , envFunctionNestingLevel = 0 }
   where bindings = Map.fromList [ templateExit ]
 
+
 -- | A template function for exiting.
 templateExit :: (String, Binder)
 templateExit = defineTemplate

test/pointer.carp

@@ -0,0 +1,38 @@
+(load "Test.carp")
+
+(use-all Test Pointer)
+
+; we go to the middle of a chunk of 10 safe elements
+(def x (add (Array.raw (the (Array Int) (Array.allocate 10))) 5l))
+(def xa (to-long x))
+(def w (width x))
+
+; these tests are sadly a little unsafe
+(deftest test
+  (assert-equal test
+                1l
+                ; we assume that the width of a char is 1
+                (width (Array.raw (the (Array Char) [])))
+                "Pointer.width works as expected"
+  )
+  (assert-equal test
+                (+ xa (* 3l w))
+                (to-long (add x 3l))
+                "Pointer.add works as expected"
+  )
+  (assert-equal test
+                (- xa (* 3l w))
+                (to-long (sub x 3l))
+                "Pointer.sub works as expected"
+  )
+  (assert-equal test
+                (+ xa w)
+                (to-long (inc x))
+                "Pointer.inc works as expected"
+  )
+  (assert-equal test
+                (- xa w)
+                (to-long (dec x))
+                "Pointer.dec works as expected"
+  )
+)