REPLACE WITH HASKELL VERSION

.gitignore

@@ -1,39 +1,12 @@
 *.dSYM
-a.out
-.DS_Store
+*/.DS_Store
 
-/gl-constants/gl_constants.o
+.stack-work/
 
-/out/*.c
-/out/*.so
-/out/*.h
-/out/*.dll
-/out/*.exp
-/out/*.lib
-/out/*.pdb
-/out/*.ilk
-/out/*.obj
-/out/exe
-
-/src/*.o
-
-/bin/carp-repl
-/bin/Release/
-/bin/Debug/
-
-/build/
-/examples/exe
-/src/TAGS
+/CarpHask-exe.prof
 
-sourcetree.license
-
-.idea/
-temp/
-
-/TAGS
-/bin/project.carp
-instrumentations/
-/CMakeCache.txt
-CMakeFiles/
-/cmake_install.cmake
-/Makefile
+/out/*.so
+/out/.DS_Store
+/out/a.out
+/out/main.c
+/.DS_Store

CarpHask.cabal

@@ -0,0 +1,64 @@
+name:                CarpHask
+version:             0.2.0.0
+-- synopsis:
+-- description:
+homepage:            https://github.com/eriksvedang/Carp
+license:             Apache-2.0
+license-file:        LICENSE
+author:              Erik Svedäng
+maintainer:          erik.svedang@gmail.com
+copyright:           Erik Svedäng
+category:            General
+build-type:          Simple
+extra-source-files:  README.md
+cabal-version:       >=1.10
+
+library
+  hs-source-dirs:      src
+  exposed-modules:     Obj,
+                       Parsing,
+                       Infer,                       
+                       Emit,
+                       ColorText,
+                       Constraints,
+                       Deftype,
+                       Commands,
+                       Template,
+                       Types,
+                       Util,
+                       Eval
+
+  build-depends:       base >= 4.7 && < 5
+                     , parsec == 3.1.*
+                     , mtl
+                     , containers
+                     , process
+                     , directory
+                     , split
+
+  default-language:    Haskell2010
+
+executable CarpHask-exe
+  hs-source-dirs:      app
+  main-is:             Main.hs
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , CarpHask
+                     , containers
+                     , process
+  default-language:    Haskell2010
+
+test-suite CarpHask-test
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      test
+  main-is:             Spec.hs
+  build-depends:       base
+                     , CarpHask
+                     , HUnit
+                     , containers
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  default-language:    Haskell2010
+
+source-repository head
+  type:     git
+  location: https://github.com/eriksvedang/Carp

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

app/Main.hs

@@ -0,0 +1,90 @@
+module Main where
+
+import Control.Monad
+import qualified System.Environment as SystemEnvironment
+import System.IO (hFlush, stdout)
+import qualified Data.Map as Map
+import ColorText
+import Obj
+import Types
+import Commands
+import Template
+import Parsing
+
+defaultProject :: Project
+defaultProject = Project { projectTitle = "Untitled"
+                         , projectIncludes = [SystemInclude "prelude.h"]
+                         , projectCFlags = []
+                         , projectLibFlags = []
+                         , projectFiles = []
+                         , projectEchoC = False
+                         , projectCarpDir = "./"
+                         , projectOutDir = "./out/"
+                         }
+
+repl :: Context -> String -> IO ()
+repl context readSoFar =
+  do putStrWithColor Yellow (if null readSoFar then "鲮 " else "     ") -- 鲤 / 鲮
+     hFlush stdout
+     input <- fmap (\s -> readSoFar ++ s ++ "\n") getLine
+     case balance input of
+       0 -> do let input' = if input == "\n" then contextLastInput context else input
+               context' <- executeString context input'
+               repl (context' { contextLastInput = input' }) ""
+       _ -> repl context input
+
+arrayModule :: Env
+arrayModule = Env { envBindings = bindings, envParent = Nothing, envModuleName = Just "Array", envImports = [], envMode = ExternalEnv }
+  where bindings = Map.fromList [ templateNth
+                                , templateReplicate
+                                , templateRepeat
+                                , templateMap
+                                , templateRaw
+                                , templateAset
+                                , templateAsetBang
+                                , templateCount
+                                , templatePushBack
+                                , templatePopBack
+                                , templateDeleteArray
+                                , templateCopyArray
+                                ]
+
+startingGlobalEnv :: Env
+startingGlobalEnv = Env { envBindings = bs, envParent = Nothing, envModuleName = Nothing, envImports = [], envMode = ExternalEnv }
+  where bs = Map.fromList [ register "and" (FuncTy [BoolTy, BoolTy] BoolTy)
+                          , register "or" (FuncTy [BoolTy, BoolTy] BoolTy)
+                          , register "not" (FuncTy [BoolTy] BoolTy)
+                          , templateNoop
+                          , ("Array", Binder (XObj (Mod arrayModule) Nothing Nothing))
+                          , register "NULL" (VarTy "a")
+                          ]
+
+startingTypeEnv :: Env
+startingTypeEnv = Env { envBindings = Map.empty, envParent = Nothing, envModuleName = Nothing, envImports = [], envMode = ExternalEnv }
+
+preludeModules :: String -> [String]
+preludeModules carpDir = map (\s -> carpDir ++ "/core/" ++ s ++ ".carp") [ "Int"
+                                                                         , "Double"
+                                                                         , "Float"
+                                                                         , "Array"
+                                                                         , "String"
+                                                                         , "Char"
+                                                                         , "IO"
+                                                                         , "System"
+                                                                         , "Macros"
+                                                                         ]
+
+main :: IO ()
+main = do putStrLn "Welcome to Carp 0.2.0"
+          putStrLn "This is free software with ABSOLUTELY NO WARRANTY."
+          putStrLn "Evaluate (help) for more information."
+          args <- SystemEnvironment.getArgs
+          sysEnv <- SystemEnvironment.getEnvironment
+          let projectWithFiles = defaultProject { projectFiles = args }
+              projectWithCarpDir = case lookup "CARP_DIR" sysEnv of
+                                     Just carpDir -> projectWithFiles { projectCarpDir = carpDir }
+                                     Nothing -> projectWithFiles
+          context <- foldM executeCommand (Context startingGlobalEnv startingTypeEnv [] projectWithCarpDir "")
+                                          (map Load (preludeModules (projectCarpDir projectWithCarpDir)))
+          context' <- foldM executeCommand context (map Load args)
+          repl context' ""

core/Array.carp

@@ -0,0 +1,12 @@
+(defmodule Array
+  (register str (Fn [(Ref (Array t))] String))
+  (register range (Fn [Int Int] (Array Int)))
+  (register sum (Fn [(Ref (Array Int))] Int))
+  )
+
+;; Other Array functions available:
+;; raw : (Fn [(Array t)] (Ptr t))
+;; nth : (Fn [(Array t) Int] t)
+;; aset! : (Fn [(Array t) Int t] ())
+;; count : (Fn [(Array t)] Int)
+;; replicate : (Fn [Int t] (Array t))

core/Char.carp

@@ -0,0 +1,2 @@
+(defmodule Char
+  (register str (Fn [Char] String)))

core/Double.carp

@@ -0,0 +1,10 @@
+(defmodule Double
+  (register + (Fn [Double Double] Double))
+  (register - (Fn [Double Double] Double))
+  (register * (Fn [Double Double] Double))
+  (register / (Fn [Double Double] Double))
+  (register toInt (Fn [Double] Int))
+  (register fromInt (Fn [Int] Double))
+  (register sin (Fn [Double] Double))
+  (register cos (Fn [Double] Double))
+  )

core/Float.carp

@@ -0,0 +1,6 @@
+(defmodule Float
+  (register + (Fn [Float Float] Float))
+  (register - (Fn [Float Float] Float))
+  (register * (Fn [Float Float] Float))
+  (register / (Fn [Float Float] Float))
+  (register toInt (Fn [Float] Int)))

core/IO.carp

@@ -0,0 +1,5 @@
+(defmodule IO
+  (register println (Fn [(Ref String)] ()))
+  (register print (Fn [(Ref String)] ()))
+  (register get-line (Fn [] String))
+  )

core/Int.carp

@@ -0,0 +1,18 @@
+(defmodule Int
+  (register + (Fn [Int Int] Int))
+  (register - (Fn [Int Int] Int))
+  (register * (Fn [Int Int] Int))
+  (register / (Fn [Int Int] Int))
+  (register < (Fn [Int Int] Bool))
+  (register > (Fn [Int Int] Bool))
+  (register = (Fn [Int Int] Bool))
+  (register mod (Fn [Int Int] Int))
+  (register seed (Fn [Int] ()))
+  (register random (Fn [] Int))
+  (register random-between (Fn [Int Int] Int))
+  (register str (Fn [Int] String))
+  (register from-string (Fn [String] Int))
+  (register mask (Fn [Int Int] Bool))
+  (register inc (Fn [Int] Int))
+  (register dec (Fn [Int] Int)))
+

core/Macros.carp

@@ -0,0 +1,32 @@
+(defdynamic cond-internal [xs]
+  (if (= (count xs) 0)
+    (list)
+    (if (= (count xs) 2)
+      (list)
+      (if (= (count xs) 1)
+        (car xs)
+        (list
+         (quote if)
+         (car xs)
+         (car (cdr xs))
+         (cond-internal (cdr (cdr xs))))))))
+
+(defmacro cond [:rest xs]
+  (cond-internal xs))
+
+(defmacro for [settings body] ;; settings = variable, from, to, <step>
+  (list
+   (quote let)
+   (array (car settings) (car (cdr settings)))
+   (list
+    (quote while)
+    (list (quote Int.<) (car settings) (car (cdr (cdr settings))))
+    (list (quote do)
+          body
+          (list
+           (quote set!) (car settings)
+           (list (quote Int.+)
+                 (car settings)
+                 (if (= 4 (count settings)) ;; optional arg for step
+                   (car (cdr (cdr (cdr settings))))
+                   1)))))))