Some Racket CG fixes

libc needs a version number, and we need to make sure we're not
generating FFI definitions more than once

libs/base/Data/Buffer.idr

@@ -12,9 +12,6 @@ support fn = "C:" ++ fn ++ ", libidris2_support"
 %foreign support "idris2_getBufferSize"
 prim__bufferSize : AnyPtr -> Int
 
-%foreign support "idris2_isNull"
-prim__nullPtr : AnyPtr -> Int
-
 export
 rawSize : Buffer -> IO Int
 rawSize (MkBuffer buf _ _)
@@ -30,7 +27,7 @@ export
 newBuffer : Int -> IO (Maybe Buffer)
 newBuffer size
     = do buf <- primIO (prim__newBuffer size)
-         if prim__nullPtr buf /= 0
+         if prim__nullAnyPtr buf /= 0
             then pure Nothing
             else pure $ Just $ MkBuffer buf size 0
 
@@ -158,7 +155,7 @@ export
 createBufferFromFile : String -> IO (Either FileError Buffer)
 createBufferFromFile fn
     = do buf <- primIO (prim__readBufferFromFile fn)
-         if prim__nullPtr buf /= 0
+         if prim__nullAnyPtr buf /= 0
             then pure (Left FileReadError)
             else do let sz = prim__bufferSize buf
                     pure (Right (MkBuffer buf sz sz))

libs/base/System.idr

@@ -27,7 +27,7 @@ export
 getArgs : IO (List String)
 getArgs = primIO prim__getArgs
 
-%foreign "C:getenv,libc"
+%foreign "C:getenv,libc 6"
 prim_getEnv : String -> PrimIO (Ptr String)
 
 export
@@ -38,7 +38,7 @@ getEnv var
            then pure Nothing
            else pure (Just (prim__getString env))
 
-%foreign "C:system,libc"
+%foreign "C:system,libc 6"
          "scheme:blodwen-system"
 prim_system : String -> PrimIO Int
 

libs/base/System/File.idr

@@ -32,7 +32,7 @@ prim__readChars : Int -> FilePtr -> PrimIO (Ptr String)
 prim__writeLine : FilePtr -> String -> PrimIO Int
 %foreign support "idris2_eof"
 prim__eof : FilePtr -> PrimIO Int
-%foreign "C:fflush,libc"
+%foreign "C:fflush,libc 6"
 prim__flush : FilePtr -> PrimIO Int
 
 %foreign support "idris2_fileRemove"

libs/prelude/PrimIO.idr

@@ -41,9 +41,9 @@ io_bind (MkIO fn) k
                       MkIO res = k x' in
                       res w')
 
-%foreign "C:putchar,libc"
+%foreign "C:putchar,libc 6"
 prim__putChar : Char -> (1 x : %World) -> IORes ()
-%foreign "C:getchar,libc"
+%foreign "C:getchar,libc 6"
 %extern prim__getChar : (1 x : %World) -> IORes Char
 
 -- A pointer representing a given parameter type

src/Compiler/Scheme/Racket.idr

@@ -36,7 +36,6 @@ schHeader libs
     "(require racket/math)\n" ++ -- for math ops
     "(require racket/promise)\n" ++ -- for force/delay
     "(require racket/system)\n" ++ -- for system
-    "(require rnrs/bytevectors-6)\n" ++ -- for buffers
     "(require rnrs/io/ports-6)\n" ++ -- for file handling
     "(require srfi/19)\n" ++ -- for file handling and data
     "(require ffi/unsafe ffi/unsafe/define)\n" ++ -- for calling C
@@ -96,6 +95,9 @@ data Loaded : Type where
 -- Label for noting which struct types are declared
 data Structs : Type where
 
+-- Label for noting which foreign names are declared
+data Done : Type where
+
 cftySpec : FC -> CFType -> Core String
 cftySpec fc CFUnit = pure "_void"
 cftySpec fc CFInt = pure "_int"
@@ -144,12 +146,15 @@ handleRet : CFType -> String -> String
 handleRet CFUnit op = op ++ " " ++ mkWorld (schConstructor racketString (UN "") (Just 0) [])
 handleRet ret op = mkWorld (cToRkt ret op)
 
-cCall : {auto c : Ref Ctxt Defs} ->
+cCall : {auto f : Ref Done (List String) } ->
+        {auto c : Ref Ctxt Defs} ->
         {auto l : Ref Loaded (List String)} ->
         FC -> (cfn : String) -> (clib : String) ->
         List (Name, CFType) -> CFType -> Core (String, String)
 cCall fc cfn libspec args ret
     = do loaded <- get Loaded
+         bound <- get Done
+
          let (libn, vers) = getLibVers libspec
          lib <- if libn `elem` loaded
                    then pure ""
@@ -161,9 +166,12 @@ cCall fc cfn libspec args ret
          argTypes <- traverse (\a => do s <- cftySpec fc (snd a)
                                         pure (a, s)) args
          retType <- cftySpec fc ret
-         let cbind = "(define-" ++ libn ++ " " ++ cfn ++
-                     " (_fun " ++ showSep " " (map snd argTypes) ++ " -> " ++
-                         retType ++ "))\n"
+         cbind <- if cfn `elem` bound
+                     then pure ""
+                     else do put Done (cfn :: bound)
+                             pure $ "(define-" ++ libn ++ " " ++ cfn ++
+                                    " (_fun " ++ showSep " " (map snd argTypes) ++ " -> " ++
+                                        retType ++ "))\n"
          let call = "(" ++ cfn ++ " " ++
                     showSep " " !(traverse useArg argTypes) ++ ")"
 
@@ -216,7 +224,8 @@ schemeCall fc sfn argns ret
 -- Use a calling convention to compile a foreign def.
 -- Returns any preamble needed for loading libraries, and the body of the
 -- function call.
-useCC : {auto c : Ref Ctxt Defs} ->
+useCC : {auto f : Ref Done (List String) } ->
+        {auto c : Ref Ctxt Defs} ->
         {auto l : Ref Loaded (List String)} ->
         FC -> List String -> List (Name, CFType) -> CFType -> Core (String, String)
 useCC fc [] args ret
@@ -255,7 +264,8 @@ mkStruct (CFIORes t) = mkStruct t
 mkStruct (CFFun a b) = do mkStruct a; mkStruct b
 mkStruct _ = pure ""
 
-schFgnDef : {auto c : Ref Ctxt Defs} ->
+schFgnDef : {auto f : Ref Done (List String) } ->
+            {auto c : Ref Ctxt Defs} ->
             {auto l : Ref Loaded (List String)} ->
             {auto s : Ref Structs (List String)} ->
             FC -> Name -> NamedDef -> Core (String, String)
@@ -273,7 +283,8 @@ schFgnDef fc n (MkNmForeign cs args ret)
                 body ++ "))\n")
 schFgnDef _ _ _ = pure ("", "")
 
-getFgnCall : {auto c : Ref Ctxt Defs} ->
+getFgnCall : {auto f : Ref Done (List String) } ->
+             {auto c : Ref Ctxt Defs} ->
              {auto l : Ref Loaded (List String)} ->
              {auto s : Ref Structs (List String)} ->
              (Name, FC, NamedDef) -> Core (String, String)
@@ -287,6 +298,7 @@ compileToRKT c tm outfile
          let ctm = forget (mainExpr cdata)
 
          defs <- get Ctxt
+         f <- newRef {t = List String} Done empty
          l <- newRef {t = List String} Loaded []
          s <- newRef {t = List String} Structs []
          fgndefs <- traverse getFgnCall ndefs