Merge branch 'master' into match-on-refs

.github/workflows/carp.yml

@@ -0,0 +1,35 @@
+name: CI
+
+on:
+  push:
+    branches: [ master ]
+  pull_request:
+    branches: [ master ]
+
+jobs:
+  build:
+    runs-on: ubuntu-18.04
+
+    steps:
+    - uses: actions/checkout@v2
+
+    - uses: actions/setup-haskell@v1
+
+    - run:   echo ::set-env name=GITHUB_SHA::$GITHUB_SHA
+      shell: bash
+
+    - uses: actions/cache@v1
+      name: Cache ~/.stack
+      with:
+        path: ~/.stack
+        key: ${{ runner.os }}-stack-${{ env.GITHUB_SHA }}
+        restore-keys: ${{ runner.os }}-stack-
+
+    - name: Build
+      run: stack build
+
+    - name: Run Compiler Tests
+      run: stack test
+
+    - name: Run Carp Tests
+      run: ./run_carp_tests.sh --no_sdl

.github/workflows/windows.yml

@@ -0,0 +1,53 @@
+name: Windows CI
+
+on:
+  push:
+    branches-ignore:
+      - '**'
+
+jobs:
+  build:
+    runs-on: windows-latest
+
+    steps:
+      - name: Check out
+        uses: actions/checkout@v2
+
+      - name: Save git commit SHA
+        run: echo ::set-env name=GITHUB_SHA::%GITHUB_SHA%
+        shell: cmd
+
+      - name: Install Scoop
+        run: |
+          iwr -useb get.scoop.sh | iex
+          echo "::add-path::~\scoop\shims"
+          echo "::add-path::C:\ProgramData\scoop\shims"
+
+      - name: Install Stack
+        run: scoop install stack
+
+      - uses: actions/cache@v1
+        name: Cache stack dependencies
+        with:
+          path: C:\\Users\\runneradmin\\AppData\\Local\\Programs\\stack
+          key: ${{ runner.os }}-stack-deps-${{ env.GITHUB_SHA }}
+          restore-keys: ${{ runner.os }}-stack-deps
+
+      - uses: actions/cache@v1
+        name: Cache stack build
+        with:
+          path: C:\\Users\\runneradmin\\AppData\\Roaming\\stack\
+          key: ${{ runner.os }}-stack-build-${{ env.GITHUB_SHA }}
+          restore-keys: ${{ runner.os }}-stack-build
+
+      - name: Install Clang
+        run: scoop install llvm --global
+
+      - name: Build
+        run: stack build
+
+      - name: Run Compiler Tests
+        run: stack test
+
+      - name: Run Carp Tests
+        run: ./run_carp_tests.ps1

CarpHask.cabal

@@ -37,6 +37,7 @@ library
                        Polymorphism,
                        Concretize,
                        ArrayTemplates,
+                       StaticArrayTemplates,
                        Expand,
                        Scoring,
                        Lookup,
@@ -46,6 +47,7 @@ library
                        RenderDocs,
                        StructUtils,
                        Path,
+                       Primitives,
                        Validate
 
   build-depends:       base >= 4.7 && < 5

README.md

@@ -1,6 +1,6 @@
 # Carp
 
-[![Join the chat at https://gitter.im/eriksvedang/Carp](https://badges.gitter.im/eriksvedang/Carp.svg)](https://gitter.im/eriksvedang/Carp?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)
+[![Join the chat at https://gitter.im/eriksvedang/Carp](https://badges.gitter.im/eriksvedang/Carp.svg)](https://gitter.im/eriksvedang/Carp?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) [![CI](https://github.com/carp-lang/Carp/workflows/CI/badge.svg)](https://github.com/carp-lang/Carp/actions?query=workflow%3ACI)
 
 <img src="https://github.com/carp-lang/Carp/blob/master/img/carp_logo_300_c.png" alt="Logo" align="right" />
 
@@ -67,6 +67,8 @@ To build this example, save it to a file called 'example.carp' and load it with
 * Joel Kaasinen ([@opqdonut](https://github.com/opqdonut))
 * Eric Shimizu Karbstein ([@GrayJack](https://github.com/GrayJack))
 * Jorge Acereda ([@jacereda](https://github.com/jacereda))
+* Scott Olsen ([@scolsen](https://github.com/scolsen))
+* Tim Dévé ([@timdeve](https://github.com/TimDeve))
 
 Are you missing from the contributors list? Please send a pull request!
 

app/Main.hs

@@ -11,7 +11,6 @@ import Repl
 import StartingEnv
 import Eval
 import Util
-import Lookup
 import Path
 
 defaultProject :: Project
@@ -70,11 +69,13 @@ main = do setLocaleEncoding utf8
               projectWithCustomPrompt = setCustomPromptFromOptions projectWithCarpDir otherOptions
               startingContext = Context
                                  (startingGlobalEnv noArray)
+                                 Nothing
                                  (TypeEnv startingTypeEnv)
-                                  []
-                                  projectWithCustomPrompt
-                                  ""
-                                  execMode
+                                 []
+                                 projectWithCustomPrompt
+                                 ""
+                                 execMode
+                                 []
           context <- loadFiles startingContext coreModulesToLoad
           carpProfile <- configPath "profile.carp"
           hasProfile <- doesFileExist carpProfile
@@ -82,20 +83,20 @@ main = do setLocaleEncoding utf8
                       then loadFiles context [carpProfile]
                       else return context
           finalContext <- loadFiles context' argFilesToLoad
-          settings <- readlineSettings (bindingNames $ contextGlobalEnv finalContext)
           case execMode of
             Repl -> do putStrLn "Welcome to Carp 0.3.0"
                        putStrLn "This is free software with ABSOLUTELY NO WARRANTY."
                        putStrLn "Evaluate (help) for more information."
-                       runInputT settings (repl finalContext "")
-            Build -> do _ <- executeString True finalContext ":b" "Compiler (Build)"
+                       _ <- runRepl finalContext
+                       return ()
+            Build -> do _ <- executeString True False finalContext "(build)" "Compiler (Build)"
                         return ()
             Install thing ->
-              do _ <- executeString True finalContext
+              do _ <- executeString True False finalContext
                       ("(load \"" ++ thing ++ "\")")
                       "Installation"
                  return ()
-            BuildAndRun -> do _ <- executeString True finalContext ":bx" "Compiler (Build & Run)"
+            BuildAndRun -> do _ <- executeString True False finalContext "(do (build) (run))" "Compiler (Build & Run)"
                               -- TODO: Handle the return value from executeString and return that one to the shell
                               return ()
             Check -> return ()

core/Array.carp

@@ -279,7 +279,7 @@ Example:
 
 The trailing elements of the longer array will be discarded.")
   (defn zip [f a b]
-    (let-do [l (Int.min (length a) (length b))
+    (let-do [l (min (length a) (length b))
              na (allocate l)]
       (for [i 0 l]
         (aset-uninitialized! &na i (~f (unsafe-nth a i) (unsafe-nth b i))))

core/Control.carp

@@ -0,0 +1,21 @@
+;; This module contains functions that deal with functions, control flow, etc.
+
+(defmodule Control
+
+  (doc iterate "Apply function `f` `n` times, first to `start` and then to the result of `f`. TODO: Mention fix points.")
+  (sig iterate (Fn [Int, (Ref (Fn [a] a b) c), a] a))
+  (defn iterate [n f start]
+    (let-do [result start]
+      (for [i 0 n]
+        (set! result (~f result)))
+      result))
+
+  (doc iterate-until "Like `iterate`, but f is applied repeatedly until the predicate `pred` is true.")
+  (sig iterate-until (Fn [a, (Ref (Fn [b] b c) d), (Ref (Fn [b] Bool c) e), b] b))
+  (defn iterate-until [f pred start]
+    (let-do [result start]
+      (while (not (~pred &result))
+        (set! result (~f result)))
+      result))
+
+  )

core/Core.carp

@@ -23,8 +23,8 @@
 
 (load "Interfaces.carp")
 (load "Bool.carp")
-(load "Generics.carp")
 (load "Macros.carp")
+(load "Generics.carp")
 (load "Maybe.carp")
 (load "Result.carp")
 (load "Dynamic.carp")
@@ -35,6 +35,7 @@
 (load "Double.carp")
 (load "Float.carp")
 (load "Tuples.carp")
+(load "StaticArray.carp")
 (load "Array.carp")
 (load "Char.carp")
 (load "String.carp")
@@ -50,3 +51,4 @@
 (load "Heap.carp")
 (load "Sort.carp")
 (load "Binary.carp")
+(load "Control.carp")

core/Dynamic.carp

@@ -32,10 +32,10 @@
 ;; The following functions are not put into a module for now:
 
 (defndynamic add-cflag [flag]
-  (Project.config "cflag" flag))
+  (eval (list 'Project.config "cflag" flag)))
 
 (defndynamic add-lib [lib]
-  (Project.config "libflag" lib))
+  (eval (list 'Project.config "libflag" lib)))
 
 (defndynamic pkg-config [pkg flags]
   (Dynamic.String.join ["`pkg-config " pkg " " flags "`"]))

core/Long.carp

@@ -27,9 +27,11 @@
 to non-refs.")
   (register copy (λ [&Long] Long))
 
-  (register safe-add (λ [Long Long (Ref Long)] Bool))
-  (register safe-sub (λ [Long Long (Ref Long)] Bool))
-  (register safe-mul (λ [Long Long (Ref Long)] Bool))
+  (not-on-windows ; this seems to generate invalid code on some windows machines
+    (register safe-add (λ [Long Long (Ref Long)] Bool))
+    (register safe-sub (λ [Long Long (Ref Long)] Bool))
+    (register safe-mul (λ [Long Long (Ref Long)] Bool))
+  )
 
   (register abs (λ [Long] Long))
 

core/Macros.carp

@@ -2,46 +2,46 @@
 
 (meta-set! doc "doc" "Set documentation for a binding.")
 (defmacro doc [name string]
-  (list 'meta-set! name "doc" string))
+  (eval (list 'meta-set! name "doc" string)))
 
 (doc print-doc "Print the documentation for a binding.")
 (defmacro print-doc [name]
-  (list 'macro-log (list 'meta name "doc")))
+  (eval (list 'macro-log (list 'meta name "doc"))))
 
 (doc sig "Annotate a binding with the desired signature.")
 (defmacro sig [name signature]
-  (list 'meta-set! name "sig" signature))
+  (eval (list 'meta-set! name "sig" signature)))
 
 (doc print-sig "Print the annotated signature for a binding.")
 (defmacro print-sig [name]
-  (list 'macro-log (list 'meta name "sig")))
+  (eval (list 'macro-log (list 'meta name "sig"))))
 
 (doc hide "Mark a binding as hidden, this will make it not print with the 'info' command.")
 (defmacro hidden [name]
-  (list 'meta-set! name "hidden" true))
+  (eval (list 'meta-set! name "hidden" true)))
 
 (doc private "Mark a binding as private, this will make it inaccessible from other modules.")
 (defmacro private [name]
-  (list 'meta-set! name "private" true))
+  (eval (list 'meta-set! name "private" true)))
 
 (doc todo "sets the todo property for a binding.")
 (defmacro todo [name value]
-  (list 'meta-set! name "todo" value))
+  (eval (list 'meta-set! name "todo" value)))
 
 (doc private? "Is this binding private?")
 (defmacro private? [name]
-  (list 'not (list 'list? (meta name "private"))))
+  (eval (list 'not (list 'list? (meta name "private")))))
 
 (doc hidden? "Is this binding hidden?")
 (defmacro hidden? [name]
-  (list 'not (list 'list? (meta name "hidden"))))
+  (eval (list 'not (list 'list? (meta name "hidden")))))
 
 (defndynamic annotate-helper [name annotation]
   (cons annotation (meta name "annotations")))
 
 (doc annotate "Add an annotation to this binding.")
 (defmacro annotate [name annotation]
-  (list 'meta-set! name "annotations" (annotate-helper name annotation)))
+  (eval (list 'meta-set! name "annotations" (annotate-helper name annotation))))
 
 (defmodule Dynamic
   (defndynamic caar [pair] (car (car pair)))
@@ -98,7 +98,7 @@
           (list 'build)
           (list 'run)))
 
-  (defmacro eval [form]
+  (defmacro evaluate [form]
     (eval-internal form))
 
   (defmacro e [form]
@@ -117,9 +117,313 @@
   (doc collect-into
     "Transforms a dynamic data literal into another, preserving order")
   (defndynamic collect-into [xs f]
-    (list 'quote
-      (collect-into-internal xs (f) f)))
-  )
+    (collect-into-internal xs (f) f))
+
+  (doc empty?
+    "Returns true if the provided data literal is empty, false otherwise.")
+  (defndynamic empty? [xs]
+    (= 0 (length xs)))
+
+  (doc flip
+    "Flips the arguments of a function `f`.
+
+    For example,
+
+    ```
+    ((flip Symbol.prefix) 'Bar 'Foo)
+    => ;; (Foo.Bar)
+    ```")
+  (defndynamic flip [f]
+    (fn [x y]
+      (f y x)))
+
+  (doc compose
+    "Returns the composition of two functions `f` and `g` for functions of any
+     airity; concretely, returns a function accepting the correct number of
+     arguments for `g`, applies `g` to those arguments, then applies `f` to the
+     result.
+
+    If you only need to compose functions that take a single argument (unary arity)
+    see `comp`. Comp also generates the form that corresponds to the composition,
+    compose contrarily evaluates 'eagerly' and returns a computed symbol.
+
+    For exmaple:
+
+    ```
+    ;; a silly composition
+    ((compose empty take) 3 [1 2 3 4 5])
+    ;; => []
+
+    (String.join (collect-into ((compose reverse map) Symbol.str '(p r a c)) array))
+    ;; => 'carp'
+
+    ;; comp for comparison
+    ((comp (curry + 1) (curry + 2)) 4)
+    ;; => (+ 1 (+ 2 4))
+    ```")
+  (defndynamic compose [f g]
+    ;; Recall that **unquoted** function names evaluate to their definitions in
+    ;; dynamic contexts, e.g. f = (dyanmic f [arg] body)
+    ;;
+    ;; Right now, this cannot handle anonymous functions because they cannot be passed to apply.
+    ;; and not anonymous functions.
+    ;; commands expand to (command <name>), fns expand to a non-list.
+    ;;
+    ;; TODO: Support passing anonymous functions.
+    (if (not (Dynamic.or (list? f) (list? g)))
+	(macro-error "compose can only compose named dynamic functions. To
+		     compose anonymous functions, such as curried functions,
+                     see comp.")
+        (let [f-name (cadr f)
+              g-name (cadr g)
+              arguments (caddr g)]
+          (list 'fn arguments
+            ;; Since we call an eval to apply g immediately, we wrap the args in an
+            ;; extra quote, otherwise, users would need to double quote any sequence of
+            ;; symbols such as '(p r a c)
+            (list  f-name (list 'eval (list 'apply g-name (list 'quote arguments))))))))
+
+  ;; Dynamic.or already exists, but since it's a special form, it can't be passed
+  ;; to higher order functions like reduce. So, we define an alternative here.
+  (defndynamic or-internal [x y]
+    (if x true y))
+
+  ;; Dynamic.and already exists, but since it's a special form, it can't be passed
+  ;; to higher order functions like reduce. So, we define an alternative here.
+  (defndynamic and-internal [x y]
+    (if x y false))
+
+  (doc curry
+    "Returns a curried function accepting a single argument, that applies f to x
+    and then to the following argument.
+
+    For example,
+
+    ```
+    (map (curry Symbol.prefix 'Foo) '(bar baz))
+    ;; => (Foo.bar Foo.baz)
+    ```")
+  (defndynamic curry [f x]
+    (fn [y]
+     (f x y)))
+
+  (doc curry*
+    "Curry functions of any airity.
+
+     For example:
+
+     ```
+     (map (curry* Dynamic.zip + '(1 2 3)) '((4 5) (6)))
+     ;; => (((+ 1 4) (+ 2 5)) ((+ 1 6)))
+
+     ((curry Dynamic.zip cons '(1 2 3)) '((4 5) (6)))
+     ;; => ((cons 1 (4 5)) (cons (2 (6))))
+
+     (defndynamic add-em-up [x y z] (+ (+ x y) z))
+     (map (curry* add-em-up 1 2) '(1 2 3))
+     ;; => (4 5 6)
+     ```")
+  (defndynamic curry* [f :rest args]
+    (let [f-name (cadr f)
+          all-args (caddr f)
+          unfilled-args (- (length all-args) (length args))
+          remaining (take unfilled-args all-args)
+          ;; Quote the arguments to retain expected behavior and avoid the need
+          ;; for double quotes in curried higher-orders, e.g. zip.
+          quote-args (map quoted args)]
+    (list 'fn remaining
+      ;; eval to execute the curried function.
+      ;; otherwise, this resolves to the form that will call the function, e.g. (add-three-vals 2 3 1)
+      (list 'eval (list 'apply f-name (list 'quote (append quote-args (collect-into
+      remaining list))))))))
+
+  ;; Higher-order functions can't currently accept primitives
+  ;; For now, wrapping primitives in a function allows us to pass them
+  ;; to HOFs like map.
+  (defndynamic quoted [x]
+    (list 'quote x))
+
+  (doc reduce
+    "Reduces or 'folds' a data literal, such as a list or array, into a single
+    value through successive applications of `f`.")
+  (defndynamic reduce [f x xs]
+    (if (empty? xs)
+      x
+      (reduce f (f x (car xs)) (cdr xs))))
+
+  (hidden unreduce-internal)
+  (defndynamic unreduce-internal [f x lim acc counter]
+    ;; Currently only works with anonymous functions and named functions.
+    ;; does not work with commands.
+    (if (not (Dynamic.or (array? acc) (list? acc)))
+      (macro-error
+	"Unreduce requires a dynamic data structure to collect results, such as
+         (list) or (array).")
+      (if (= counter lim)
+        acc
+        (unreduce-internal f (f x) lim (append acc (cons (eval (f x)) (empty acc))) (+ counter 1)))))
+
+  (doc unreduce
+    "Applies `f` to a starting value `x`, then generates a sequence of values
+     by successively applying `f` to the result `lim-1` times.
+     Collects results in the structure given by `acc`.
+
+     For example:
+
+     ```
+     (unreduce (curry + 1) 0 10 (list))
+     ;; => (1 2 3 4 5 6 7 8 9 10)
+     ```")
+  (defndynamic unreduce [f x lim acc]
+    (unreduce-internal f x lim acc 0))
+
+  (doc filter
+    "Returns a list containing only the elements of `xs` that satisify predicate `p`.
+
+     For example:
+
+     ```
+     (filter (fn [x] (= 'a x)) '(a b a b a b a b))
+     ;; => (a a a a)
+     ```")
+  (defndynamic filter [p xs]
+    (let [filter-fn (fn [x y] (if (p y) (append x (list y)) x))]
+      (reduce filter-fn (list) xs)))
+
+  (doc reverse
+    "Reverses the order of elements in an array or list.
+
+     For example:
+
+     ```
+     (reverse [1 2 3 4])
+     ;; => [4 3 2 1]
+     ```")
+  (defndynamic reverse [xs]
+    (if (array? xs)
+      (reduce (flip append) (array) (map array xs))
+      (reduce (flip append) (list) (map list xs))))
+
+  (doc empty
+    "Returns the empty form of `xs`.
+
+     For example:
+
+     ```
+     (empty '(1 2 3 4))
+     ;; => ()
+     (empty '[1 2 3 4])
+     ;; => []
+     ```")
+  (defndynamic empty [xs]
+    (if (array? xs)
+        (array)
+        (list)))
+
+  (doc take
+    "Returns a list containing the first `n` eleements of a list.
+
+     For example:
+
+     ```
+     (take 3 '(1 2 3 4 5))
+     ;; => (1 2 3)
+     ```")
+  (defndynamic take [n xs]
+    ;; A more straightforward impl is likely more efficient?
+    (let [indicies (unreduce (curry + 1) 0 n (list))
+          result (map cadr (zip list xs indicies))]
+      (if (array? xs)
+          (collect-into result array)
+          result)))
+
+  (doc apply
+    "Applies the function `f` to the provided argument list, passing each value
+    in the list as an argument to the function.")
+  (defndynamic apply [f argument-list]
+    ;; The let clause here is a tad mysterious at first glance. When passed a
+    ;; standalone function name (i.e. not an application (f x), carp evaluates
+    ;; it into the function's defining form, e.g. foo becomes (defn foo [x] x),
+    ;; commands such as + become (command +) etc.  ;; The binding here accounts
+    ;; for that case, allowing users to pass the function name to apply
+    ;; unquoted.
+    ;;
+    ;; This is necessary for parity across map-internal, zip, and apply.
+    ;; Since map calls its function directly, it takes it as is. Apply, on the
+    ;; other hand, would have to take the quoted form, since it builds a list
+    ;; that serves as the actual application.
+    ;;
+    ;; This is problematic for the user facing map function, since it makes
+    ;; calls to map or zip (which uses apply) as appropriate--unless we support
+    ;; the quoted function name argument in map-internal or the unquoted one in
+    ;; apply, we can't use zip and map-internal in map.
+    (if (not (list? f))
+        (f argument-list)
+    (let [function-name (list (cadr f))]
+      (if (array? argument-list)
+          (append function-name (collect-into argument-list list))
+          (append function-name argument-list)))))
+
+  (hidden map-internal)
+  (defndynamic map-internal [f xs acc]
+    (if (empty? xs)
+        acc
+        (map-internal f (cdr xs) (cons-last (f (car xs)) acc))))
+
+  (hidden zip-internal)
+  (defndynamic zip-internal [f forms acc]
+    (if (reduce or-internal false (map-internal empty? forms (list)))
+        acc
+        (zip-internal
+          f
+          (map-internal cdr forms (list))
+          (let [result (list (apply f (map-internal car forms (list))))]
+            (append acc result)))))
+
+  (doc zip
+    "Returns the *form* that results from applying  a function `f` to each of
+    the values supplied in `forms`.
+
+    If the members of a single form are exhuasted, the result of the
+    applications thus far is returned, and any remaining members in the other
+    forms are ignored.
+
+    For example,
+
+    ```
+    (zip + '(1 2 3) '(4 5 6))
+    ;; => ((+ 1 4) (+ 2 5) (+ 3 6))
+    ```
+
+    It's important to note that zip operates on forms, and that the form
+    returned by zip may not be evaluable by itself. For instance, to actually
+    transform the result in the example above into something Carp can
+    evaluate, we need to wrap each member of the list in a `do`:
+
+    ```
+    (append (list 'do) (zip + '(1 2 3) '(4 5 6)))
+    ;; => (do (+ 1 4) (+ 2 5) (+ 3 6))
+    (eval (append (list 'do) (zip + '(1 2 3) '(4 5 6))))
+    ;; => 9 ;; do returns the value of the last form in its body
+    ```")
+  (defndynamic zip [f :rest forms]
+    (zip-internal f forms (list)))
+
+  (doc map
+    "Applies a function `f` to each element in the list or array `xs` and
+     returns a list dynamic data literal containing the result of the function
+     applications.
+
+     For example:
+      ```clojure
+      '(map symbol? '(a b c))
+      => (true true true)
+      '(map (curry + 1) '(1 2 3))
+      => (2 3 4)
+      ```")
+  (defndynamic map [f xs]
+    (map-internal f xs (list)))
+)
 
 (defndynamic cond-internal [xs]
   (if (= (length xs) 0)
@@ -224,38 +528,40 @@
 
 (defmacro mac-only [:rest forms]
   (if (= "darwin" (os))
-    (cons (quote do) forms)
+    (eval (cons (quote do) forms))
     ()))
 
 (defmacro linux-only [:rest forms]
   (if (= "linux" (os))
-    (cons (quote do) forms)
+    (eval (cons (quote do) forms))
     ()))
 
 (defmacro windows-only [:rest forms]
   (if (Dynamic.or (= "windows" (os)) (= "mingw32" (os)))
-    (cons (quote do) forms)
+    (eval (cons (quote do) forms))
     ()))
 
 (defmacro not-on-windows [:rest forms]
   (if (not (Dynamic.or (= "windows" (os)) (= "mingw32" (os))))
-    (cons (quote do) forms)
+    (eval (cons (quote do) forms))
     ()))
 
 (defndynamic use-all-fn [names]
   (if (= (length names) 0)
     (macro-error "Trying to call use-all without arguments")
-    (if (= (length names) 1)
-      (list (list 'use (car names)))
-      (cons (list 'use (car names)) (use-all-fn (cdr names))))));(use-all (cdr names))))))
+    (do
+      (eval (list 'use (car names)))
+      (if (= (length names) 1)
+        ()
+        (use-all-fn (cdr names))))))
 
 (defmacro use-all [:rest names]
-  (cons 'do (use-all-fn names)))
+  (use-all-fn names))
 
 (defmacro load-and-use [name]
-  (list 'do
-        (list 'load (str name ".carp"))
-        (list 'use name)))
+  (do
+    (eval (list 'load (str name ".carp")))
+    (eval (list 'use name))))
 
 (defmacro when [condition form]
   (list 'if condition form (list)))
@@ -272,7 +578,7 @@
     (cons 'do forms)))
 
 (defmacro defn-do [name arguments :rest body]
-  (list 'defn name arguments (cons 'do body)))
+  (eval (list 'defn name arguments (cons 'do body))))
 
 (defmacro comment [:rest forms]
   ())
@@ -335,7 +641,7 @@
 
 (defmacro save-docs [:rest modules]
   ;; A trick to be able to send unquoted symbols to 'save-docs'
-  (list 'save-docs-internal (list 'quote modules)))
+  (eval (list 'save-docs-internal (list 'quote modules))))
 
 (defndynamic project-config [bindings]
   (if (< (length bindings) 2)
@@ -360,7 +666,7 @@ The expression must be evaluable at compile time.")
 (doc gensym-with "generates symbols dynamically, based on a symbol name.")
 (defndynamic gensym-with [x]
   (do
-    (defdynamic *gensym-counter* (inc *gensym-counter*))
+    (set! *gensym-counter* (inc *gensym-counter*))
     (Symbol.join [x (Symbol.from *gensym-counter*)])))
 
 (doc gensym "generates symbols dynamically as needed.")

core/SDL.carp

@@ -6,15 +6,16 @@
   (add-pkg "sdl2"))
 
 ;; Only define these if they're not already defined (allows the user to pre-define them before including SDL.carp)
-(defdynamic-once sdl-windows-header-path "C:\\SDL2-2.0.9\\include")
-(defdynamic-once sdl-windows-library-path "C:\\SDL2-2.0.9\\lib\\x86\\")
+;; Tip: Set them in your profile.carp which is located at ```C:/Users/USERNAME/AppData/Roaming/carp/profile.carp``` on Windows.
+(defdynamic-once sdl-windows-header-path "C:\\REDACTED\vcpkg\installed\x86-windows\include\SDL2\\")
+(defdynamic-once sdl-windows-library-path "C:\\REDACTED\vcpkg\installed\x86-windows\lib\\")
 
 (windows-only
   ;; Note - you'll still need the SDL2.dll to be able to run the executable
   (add-cflag "-DSDL_MAIN_HANDLED")
   (add-cflag "-Wno-pragma-pack")
   (add-cflag (str "-I" sdl-windows-header-path))
-  (add-lib (str "/link " sdl-windows-library-path "SDL2.lib "))) ;; sdl-windows-library-path "SDL2main.lib")))
+  (add-lib (str "/link " sdl-windows-library-path "SDL2.lib " sdl-windows-library-path "manual-link\SDL2main.lib")))
 
 ;; Types
 (register-type SDL_Keycode)

core/SDLHelper.h

@@ -1,4 +1,4 @@
-#include <SDL.h>
+#include <SDL2/SDL.h>
 
 // Event
 SDL_Event SDL_Event_init() {

core/SDL_image.carp

@@ -2,15 +2,10 @@
  (system-include "SDL2/SDL_image.h")
  (add-pkg "SDL2_image"))
 
-(defmodule IMG
-  (defmodule Windows
-    (defdynamic header-path "C:\\SDL2_image-2.0.4\\include")
-    (defdynamic library-path "C:\\SDL2_image-2.0.4\\lib\\x86\\")))
-
 (windows-only
   (system-include "SDL_image.h")
-  (add-cflag (str "-I" IMG.Windows.header-path))
-  (add-lib (str "/link " IMG.Windows.library-path "SDL2_image.lib ")))
+  (add-cflag (str "-I" sdl-windows-header-path))
+  (add-lib (str sdl-windows-library-path "SDL2_image.lib ")))
 
 (defmodule IMG
   (register load-texture (Fn [(Ptr SDL_Renderer) (Ptr Char)] (Ptr SDL_Texture)) "IMG_LoadTexture")

core/SafeInt.carp

@@ -1,10 +1,12 @@
 (system-include "carp_safe_int.h")
 
 (defmodule Int
-  (doc safe-add "Performs an addition and checks whether it overflowed.")
-  (register safe-add (λ [Int Int (Ref Int)] Bool))
-  (doc safe-sub "Performs an substraction and checks whether it overflowed.")
-  (register safe-sub (λ [Int Int (Ref Int)] Bool))
-  (doc safe-mul "Performs an multiplication and checks whether it overflowed.")
-  (register safe-mul (λ [Int Int (Ref Int)] Bool))
+  (not-on-windows ; this seems to generate invalid code on some windows machines
+    (doc safe-add "Performs an addition and checks whether it overflowed.")
+    (register safe-add (λ [Int Int (Ref Int)] Bool))
+    (doc safe-sub "Performs an substraction and checks whether it overflowed.")
+    (register safe-sub (λ [Int Int (Ref Int)] Bool))
+    (doc safe-mul "Performs an multiplication and checks whether it overflowed.")
+    (register safe-mul (λ [Int Int (Ref Int)] Bool))
+  )
 )

core/StaticArray.carp

@@ -0,0 +1,42 @@
+(defmodule StaticArray
+
+  (defndynamic foreach-internal [var xs expr]
+    (let [xsym (gensym-with 'xs)
+          len (gensym-with 'len)
+          i (gensym-with 'i)]
+      (list 'let [xsym xs
+                  len (list 'StaticArray.length xsym)]
+            (list 'for [i 0 len]
+                  (list 'let [var (list 'StaticArray.unsafe-nth xsym i)]
+                        expr)))))
+
+  ;; NOTE: Exact copy of the Array.foreach macro, could be made "generic" by removing the module prefixes.
+  (defmacro foreach [binding expr]
+    (StaticArray.foreach-internal (car binding) (cadr binding) expr))
+
+  (doc map! "Maps a function over the static array `xs`, mutating it in place. The difference to Array.endo-map (which does the same thing internally) is that this function takes a ref (since you can never have static arrays as values) and that it returns ().")
+  (defn map! [xs f]
+    (for [i 0 (StaticArray.length xs)]
+      (StaticArray.aset! xs i (~f (StaticArray.unsafe-nth xs i)))))
+
+  ;; NOTE: Exact copy of the Array.reduce function.
+  (defn reduce [f x xs]
+    (let [total x]
+      (do
+        (for [i 0 (StaticArray.length xs)]
+          (set! total (~f total (StaticArray.unsafe-nth xs i))))
+        total)))
+
+  (doc = "compares two static arrays.")
+  (defn = [a b]
+    (if (/= (StaticArray.length a) (StaticArray.length b))
+      false
+      (let-do [eq true]
+        (for [i 0 (StaticArray.length a)]
+          (when (/= (StaticArray.unsafe-nth a i) (StaticArray.unsafe-nth b i))
+            (do
+              (set! eq false)
+              (break))))
+        eq)))
+
+  )

core/String.carp

@@ -39,12 +39,12 @@
 
   (doc pad-left "Pads the left of a string with len bytes using the padding pad.")
   (defn pad-left [len pad s]
-    (let [x (Int.max 0 (- len (length s)))]
+    (let [x (max 0 (- len (length s)))]
       (append &(from-chars &(Array.replicate x &pad)) s)))
 
   (doc pad-right "Pads the right of a string with len bytes using the padding pad.")
   (defn pad-right [len pad s]
-    (let [x (Int.max 0 (- len (length s)))]
+    (let [x (max 0 (- len (length s)))]
       (append s &(from-chars &(Array.replicate x &pad)))))
 
   (doc count-char "Returns the number of occurrences of `c` in the string `s`.")

core/Test.carp

@@ -42,45 +42,53 @@
   (defn reset [state]
     (State.set-failed (State.set-passed state 0) 0))
 
-  (hidden run-child)
-  (defn run-child [x]
-    (let [pid (System.fork)
-          status 0]
-      (if (= pid 0)
-        (do
-          (x)
-          0)
-        (do
-          (ignore (System.wait (address status)))
-          (System.get-exit-status status)))))
+  (not-on-windows
+    (hidden run-child)
+    (defn run-child [x]
+      (let [pid (System.fork)
+            status 0]
+        (if (= pid 0)
+          (do
+            (x)
+            0)
+          (do
+            (ignore (System.wait (address status)))
+            (System.get-exit-status status)))))
 
-  (hidden handle-signal)
-  (defn handle-signal [x] (System.exit x))
+    (hidden handle-signal)
+    (defn handle-signal [x] (System.exit x))
 
-  (hidden run-child-signals)
-  (defn run-child-signals [x]
-    (let [pid (System.fork)
-          status 0]
-      (if (= pid 0)
-        (do
-          (System.signal System.signal-abort handle-signal)
-          (System.signal System.signal-fpe handle-signal)
-          (System.signal System.signal-ill handle-signal)
-          (System.signal System.signal-segv handle-signal)
-          (System.signal System.signal-term handle-signal)
-          (x)
-          0)
-        (do
-          (ignore (System.wait (address status)))
-          (System.get-exit-status status)))))
+    (hidden run-child-signals)
+    (defn run-child-signals [x]
+      (let [pid (System.fork)
+            status 0]
+        (if (= pid 0)
+          (do
+            (System.signal System.signal-abort handle-signal)
+            (System.signal System.signal-fpe handle-signal)
+            (System.signal System.signal-ill handle-signal)
+            (System.signal System.signal-segv handle-signal)
+            (System.signal System.signal-term handle-signal)
+            (x)
+            0)
+          (do
+            (ignore (System.wait (address status)))
+            (System.get-exit-status status)))))
 
-  (doc assert-exit "Assert that function f exits with exit code exit-code.")
-  (defn assert-exit [state exit-code f descr]
-    (assert-equal state exit-code (run-child f) descr))
+    (doc assert-exit "Assert that function f exits with exit code exit-code.")
+    (defn assert-exit [state exit-code f descr]
+      (assert-equal state exit-code (run-child f) descr))
 
-  (doc assert-exit "Assert that function f aborts with OS signal signal.")
-  (defn assert-signal [state signal x descr]
-    (assert-equal state signal (run-child-signals x) descr))
+    (doc assert-signal "Assert that function f aborts with OS signal signal.")
+    (defn assert-signal [state signal x descr]
+      (assert-equal state signal (run-child-signals x) descr)))
+
+  (windows-only
+    (defndynamic assert-exit [state exit-code f descr]
+      (macro-error "assert-exit is not implemented on Windows."))
+
+    (defndynamic assert-signal [state signal x descr]
+      (macro-error "assert-signal is not implemented on Windows.")))
 
   (doc print-test-results "Print test results.")
   (defn print-test-results [state]
@@ -123,10 +131,11 @@
     ))
 
 (defmacro deftest [name :rest forms]
-  (list 'defn 'main (array)
-    (list 'let (array name '&(Test.State.init 0 0))
-      (cons-last
-        (list 'Int.copy (list 'Test.State.failed name))
+  (eval
+    (list 'defn 'main (array)
+      (list 'let (array name '&(Test.State.init 0 0))
         (cons-last
-          (list 'Test.print-test-results name)
-          (cons 'do (with-test-internal name forms)))))))
+          (list 'Int.copy (list 'Test.State.failed name))
+          (cons-last
+            (list 'Test.print-test-results name)
+            (cons 'do (with-test-internal name forms))))))))

core/carp_binary.h

@@ -10,9 +10,9 @@ uint32_t Binary_to_MINUS_int32(uint8_t b1, uint8_t b2, uint8_t b3, uint8_t b4) {
 
 uint64_t Binary_to_MINUS_int64(uint8_t b1, uint8_t b2, uint8_t b3, uint8_t b4,
                                uint8_t b5, uint8_t b6, uint8_t b7, uint8_t b8) {
-    return (uint64_t)b1 | (b2 << 8) | (b3 << 16) | (b4 << 24) |
-           ((uint64_t)b5 << 32) | ((uint64_t)b6 << 40) | ((uint64_t)b7 << 48) |
-           ((uint64_t)b8 << 56);
+    return (uint64_t)b1 | ((uint64_t)b2 << 8) | ((uint64_t)b3 << 16) |
+           ((uint64_t)b4 << 24) | ((uint64_t)b5 << 32) | ((uint64_t)b6 << 40) |
+           ((uint64_t)b7 << 48) | ((uint64_t)b8 << 56);
 }
 
 uint8_t Binary_int16_MINUS_to_MINUS_byte(uint16_t *x) {

core/carp_double.h

@@ -38,8 +38,8 @@ double Double_from_MINUS_int(int x) {
     return (double)x;
 }
 
-long Double_to_MINUS_bytes(double x) {
-    long y;
+Long Double_to_MINUS_bytes(double x) {
+    Long y;
     memcpy(&y, &x, sizeof(double));
     return y;
 }
@@ -52,11 +52,11 @@ double Double_from_MINUS_float(float x) {
     return (double)x;
 }
 
-long Double_to_MINUS_long(double x) {
-    return (long)x;
+Long Double_to_MINUS_long(double x) {
+    return (Long)x;
 }
 
-double Double_from_MINUS_long(long x) {
+double Double_from_MINUS_long(Long x) {
     return (double)x;
 }
 

core/carp_io.h

@@ -75,7 +75,7 @@ String IO_get_MINUS_line() {
 
 String IO_read_MINUS_file(const String *filename) {
     String buffer = 0;
-    long length;
+    Long length;
     FILE *f = fopen(*filename, "rb");
 
     if (f) {

core/carp_long.h

@@ -1,87 +1,87 @@
-long Long__PLUS_(long x, long y) {
+Long Long__PLUS_(Long x, Long y) {
     return x + y;
 }
-long Long__MINUS_(long x, long y) {
+Long Long__MINUS_(Long x, Long y) {
     return x - y;
 }
-long Long__MUL_(long x, long y) {
+Long Long__MUL_(Long x, Long y) {
     return x * y;
 }
-long Long__DIV_(long x, long y) {
+Long Long__DIV_(Long x, Long y) {
     return x / y;
 }
 #ifndef _WIN32
-bool Long_safe_MINUS_add(long x, long y, long* res) {
-    return __builtin_saddl_overflow(x, y, res);
+bool Long_safe_MINUS_add(Long x, Long y, Long* res) {
+    return __builtin_add_overflow(x, y, res);
 }
-bool Long_safe_MINUS_sub(long x, long y, long* res) {
-    return __builtin_ssubl_overflow(x, y, res);
+bool Long_safe_MINUS_sub(Long x, Long y, Long* res) {
+    return __builtin_sub_overflow(x, y, res);
 }
-bool Long_safe_MINUS_mul(long x, long y, long* res) {
-    return __builtin_smull_overflow(x, y, res);
+bool Long_safe_MINUS_mul(Long x, Long y, Long* res) {
+    return __builtin_mul_overflow(x, y, res);
 }
 #endif
-bool Long__EQ_(long x, long y) {
+bool Long__EQ_(Long x, Long y) {
     return x == y;
 }
-bool Long__LT_(long x, long y) {
+bool Long__LT_(Long x, Long y) {
     return x < y;
 }
-bool Long__GT_(long x, long y) {
+bool Long__GT_(Long x, Long y) {
     return x > y;
 }
-long Long_neg(long x) {
+Long Long_neg(Long x) {
     return -x;
 }
 
-long Long_inc(long x) {
+Long Long_inc(Long x) {
     return x + 1;
 }
-long Long_dec(long x) {
+Long Long_dec(Long x) {
     return x - 1;
 }
-long Long_abs(long x) {
+Long Long_abs(Long x) {
     return x > 0 ? x : -x;
 }
-long Long_bit_MINUS_shift_MINUS_left(long x, long y) {
+Long Long_bit_MINUS_shift_MINUS_left(Long x, Long y) {
     return x << y;
 }
-long Long_bit_MINUS_shift_MINUS_right(long x, long y) {
+Long Long_bit_MINUS_shift_MINUS_right(Long x, Long y) {
     return x >> y;
 }
-long Long_bit_MINUS_and(long x, long y) {
+Long Long_bit_MINUS_and(Long x, Long y) {
     return x & y;
 }
-long Long_bit_MINUS_or(long x, long y) {
+Long Long_bit_MINUS_or(Long x, Long y) {
     return x | y;
 }
-long Long_bit_MINUS_xor(long x, long y) {
+Long Long_bit_MINUS_xor(Long x, Long y) {
     return x ^ y;
 }
-long Long_bit_MINUS_not(long x) {
+Long Long_bit_MINUS_not(Long x) {
     return ~x;
 }
 
-long Long_copy(const long* x) {
+Long Long_copy(const Long* x) {
     return *x;
 }
 
-long Long_mod(long x, long divider) {
+Long Long_mod(Long x, Long divider) {
     return x % divider;
 }
 
-void Long_seed(long seed) {
+void Long_seed(Long seed) {
     srand(seed);
 }
 
-bool Long_mask(long a, long b) {
+bool Long_mask(Long a, Long b) {
     return a & b;
 }
 
-int Long_to_MINUS_int(long a) {
+int Long_to_MINUS_int(Long a) {
     return (int)a;
 }
 
-long Long_from_MINUS_int(int a) {
-    return (long)a;
+Long Long_from_MINUS_int(int a) {
+    return (Long)a;
 }

core/carp_memory.h

@@ -1,12 +1,12 @@
 #ifdef LOG_MEMORY
 
-long malloc_balance_counter = 0;
+Long malloc_balance_counter = 0;
 bool log_memory_balance = false;
 
 void *logged_malloc(size_t size) {
     void *ptr = malloc(size);
     if (log_memory_balance) {
-        printf("MALLOC: %p (%ld bytes)\n", ptr, size);
+        printf("MALLOC: %p (%zu bytes)\n", ptr, size);
     }
     malloc_balance_counter++;
     return ptr;
@@ -35,7 +35,7 @@ void Debug_log_MINUS_memory_MINUS_balance_BANG_(bool value) {
 #define CARP_FREE(ptr) logged_free(ptr)
 #define CARP_REALLOC(ptr, size) realloc(ptr, size)
 
-long Debug_memory_MINUS_balance() {
+Long Debug_memory_MINUS_balance() {
     return malloc_balance_counter;
 }
 
@@ -63,7 +63,7 @@ void* CARP_REALLOC(void* ptr, size_t size) {
 
 #define CARP_FREE(ptr) free(ptr)
 
-long Debug_memory_MINUS_balance() {
+Long Debug_memory_MINUS_balance() {
     printf(
         "Error - calling 'memory-balance' without compiling with LOG_MEMORY "
         "enabled (--log-memory).\n");

core/carp_safe_int.h

@@ -1,9 +1,11 @@
+#ifndef _WIN32
 bool Int_safe_MINUS_add(int x, int y, int* res) {
-    return __builtin_sadd_overflow(x, y, res);
+    return __builtin_add_overflow(x, y, res);
 }
 bool Int_safe_MINUS_sub(int x, int y, int* res) {
-    return __builtin_ssub_overflow(x, y, res);
+    return __builtin_sub_overflow(x, y, res);
 }
 bool Int_safe_MINUS_mul(int x, int y, int* res) {
-    return __builtin_smul_overflow(x, y, res);
+    return __builtin_mul_overflow(x, y, res);
 }
+#endif

core/carp_stdint.h

@@ -52,10 +52,10 @@ String Uint8_str(Uint8 x) {
     snprintf(buffer, size, "Uint8(%" PRIu8 ")", x);
     return buffer;
 }
-Uint8 Uint8_from_MINUS_long(long x) {
+Uint8 Uint8_from_MINUS_long(Long x) {
     return (Uint8)x;
 }
-long Uint8_to_MINUS_long(Uint8 x) {
+Long Uint8_to_MINUS_long(Uint8 x) {
     return (long)x;
 }
 Uint8 Uint8_copy(Uint8* x) {
@@ -119,10 +119,10 @@ String Uint16_str(Uint16 x) {
     snprintf(buffer, size, "Uint16(%" PRIu16 ")", x);
     return buffer;
 }
-Uint16 Uint16_from_MINUS_long(long x) {
+Uint16 Uint16_from_MINUS_long(Long x) {
     return (Uint16)x;
 }
-long Uint16_to_MINUS_long(Uint16 x) {
+Long Uint16_to_MINUS_long(Uint16 x) {
     return (long)x;
 }
 Uint16 Uint16_copy(Uint16* x) {
@@ -186,10 +186,10 @@ String Uint32_str(Uint32 x) {
     snprintf(buffer, size, "Uint32(%" PRIu32 ")", x);
     return buffer;
 }
-Uint32 Uint32_from_MINUS_long(long x) {
+Uint32 Uint32_from_MINUS_long(Long x) {
     return (Uint32)x;
 }
-long Uint32_to_MINUS_long(Uint32 x) {
+Long Uint32_to_MINUS_long(Uint32 x) {
     return (long)x;
 }
 Uint32 Uint32_copy(Uint32* x) {
@@ -253,10 +253,10 @@ String Uint64_str(Uint64 x) {
     snprintf(buffer, size, "Uint64(%" PRIu64 ")", x);
     return buffer;
 }
-Uint64 Uint64_from_MINUS_long(long x) {
+Uint64 Uint64_from_MINUS_long(Long x) {
     return (Uint64)x;
 }
-long Uint64_to_MINUS_long(Uint64 x) {
+Long Uint64_to_MINUS_long(Uint64 x) {
     return (long)x;
 }
 Uint64 Uint64_copy(Uint64* x) {
@@ -320,10 +320,10 @@ String Int8_str(Int8 x) {
     snprintf(buffer, size, "Int8(%" PRId8 ")", x);
     return buffer;
 }
-Int8 Int8_from_MINUS_long(long x) {
+Int8 Int8_from_MINUS_long(Long x) {
     return (Int8)x;
 }
-long Int8_to_MINUS_long(Int8 x) {
+Long Int8_to_MINUS_long(Int8 x) {
     return (long)x;
 }
 Int8 Int8_copy(Int8* x) {
@@ -387,10 +387,10 @@ String Int16_str(Int16 x) {
     snprintf(buffer, size, "Int16(%" PRId16 ")", x);
     return buffer;
 }
-Int16 Int16_from_MINUS_long(long x) {
+Int16 Int16_from_MINUS_long(Long x) {
     return (Int16)x;
 }
-long Int16_to_MINUS_long(Int16 x) {
+Long Int16_to_MINUS_long(Int16 x) {
     return (long)x;
 }
 Int16 Int16_copy(Int16* x) {
@@ -454,10 +454,10 @@ String Int32_str(Int32 x) {
     snprintf(buffer, size, "Int32(%" PRId32 ")", x);
     return buffer;
 }
-Int32 Int32_from_MINUS_long(long x) {
+Int32 Int32_from_MINUS_long(Long x) {
     return (Int32)x;
 }
-long Int32_to_MINUS_long(Int32 x) {
+Long Int32_to_MINUS_long(Int32 x) {
     return (long)x;
 }
 Int32 Int32_copy(Int32* x) {
@@ -521,11 +521,11 @@ String Int64_str(Int64 x) {
     snprintf(buffer, size, "Int64(%" PRId64 ")", x);
     return buffer;
 }
-Int64 Int64_from_MINUS_long(long x) {
+Int64 Int64_from_MINUS_long(Long x) {
     return (Int64)x;
 }
-long Int64_to_MINUS_long(Int64 x) {
-    return (long)x;
+Long Int64_to_MINUS_long(Int64 x) {
+    return (Long)x;
 }
 Int64 Int64_copy(Int64* x) {
     return *x;

core/carp_string.h

@@ -239,21 +239,21 @@ int Int_from_MINUS_string(const String *s) {
     return atoi(*s);
 }
 
-String Long_str(long x) {
-    int size = snprintf(NULL, 0, "%ldl", x) + 1;
+String Long_str(Long x) {
+    int size = snprintf(NULL, 0, "%" PRIi64, x) + 1;
     String buffer = CARP_MALLOC(size);
-    sprintf(buffer, "%ldl", x);
+    sprintf(buffer, "%" PRIi64, x);
     return buffer;
 }
 
-String Long_format(const String *str, long x) {
+String Long_format(const String *str, Long x) {
     int size = snprintf(NULL, 0, *str, x) + 1;
     String buffer = CARP_MALLOC(size);
     sprintf(buffer, *str, x);
     return buffer;
 }
 
-long Long_from_MINUS_string(const String *s) {
+Long Long_from_MINUS_string(const String *s) {
     return atol(*s);
 }
 

core/core.h

@@ -7,21 +7,17 @@ typedef SSIZE_T ssize_t;
 #ifndef _WIN32
 #include <unistd.h>
 #endif
+#include <inttypes.h>
 
 typedef char *String;
 typedef char *Pattern;
+typedef int64_t Long;
 
 #if defined NDEBUG
 #define CHK_INDEX(i, n)
 #else
 
-#if defined(WIN32) || defined(_WIN32) || \
-    defined(__WIN32) && !defined(__CYGWIN__)
-// The %zd format flag doesn't seem to work on Windows?
-#define CHK_INDEX_FORMAT_STRING ":%u: bad index: %ld < %ld\n"
-#else
 #define CHK_INDEX_FORMAT_STRING ":%u: bad index: %zd < %zd\n"
-#endif
 
 #define CHK_INDEX(i, n)                                                    \
     do {                                                                   \

docs/Embedded.md

@@ -0,0 +1,5 @@
+# Embedded
+
+<img src="carp_on_arduboy.jpg">
+
+This document will contain information on how to set up Carp for development on low-power devices such as micro controllers.

docs/LanguageGuide.md

@@ -23,6 +23,7 @@ To learn more about the details of memory management, check out [Memory.md](http
 1500l   ;; Long
 3.14f   ;; Float
 10.0    ;; Double
+1b      ;; Byte
 true    ;; Bool
 "hello" ;; &String
 #"hello" ;; &Pattern
@@ -38,6 +39,7 @@ Int
 Long
 Float
 Double
+Byte
 Bool
 String
 Pattern

docs/Macros.md

@@ -0,0 +1,217 @@
+# Macros
+
+Macros are among the most divisive features about any Lisp. There are many
+different design decisions to be made, and all of them have proponents and
+detractors.
+
+This document aims to give a comprehensive overview of the macro system and
+how to use it. If you’re in a hurry or want to see whether Carp implements your
+favorite macro feature, you probably want to read the section [“In a
+Nutshell”](#in-a-nutshell). If you want to spend some quality understanding
+how to work on or with the macro systems, the sections [“Working with
+Macros”](#working-with-macros) and [“Inner Workings”](#inner-workings) will
+probably be more useful to you.
+
+## In a Nutshell
+
+The macro system we’ve settled on for Carp is fairly simple. It is:
+
+- not hygienic, but provides `gensym` capabilities,
+- does not currently provide quasiquoting (this is not a requirement, it is
+  currently just not implemented); thus the bread and butter in your macro
+  toolbox will be `car`, `cdr`, `cons`, and `list`,
+- defines macros with a fairly simple `defmacro`-based syntax, and has support
+  for compile-time or dynamic functions (for more information on this aspect,
+  please read [“Working with Macros”](#working-with-macros) below), and
+- it sees the dynamic environment not just as an environment in which to
+  generate code through expanding macros, but also as a place for telling the
+  compiler more about the source. As an example, consider the dynamic function
+  `Project.config`, which allows you to set such things as the C compiler to
+  use, the name of the compiled project, or the output directory. To see this
+  in action, consider [this Carp snippet](https://github.com/carpentry-org/snippets/blob/master/build_system.carp)
+  which implements a simple multi-compiler build system for Carp in the dynamic
+  environment.
+
+## Working with Macros
+
+Macros are defined using the `defmacro` primitive form, like this:
+
+```clojure
+(defmacro apply [f args] (cons f args))
+
+(apply + (1 2)) ; => (+ 1 2)
+(apply Array.replicate (5 "hello")) ; => (Array.replicate 5 "hello")
+```
+
+The example above defines `apply`, a macro that takes a function and a set of
+arguments defined as a list and rewrites it so that the function gets applied
+to these arguments by `cons`tructing a list with `f` as a head and `args` as
+tail.
+
+Because `apply` is a macro you will not need to quote the list passed to it. If
+that looks strange, you might want to define `apply` as a dynamic function
+instead. The main difference between macros and dynamic functions is that
+dynamic functions evaluate their arguments and macros are expanded inside their
+definitions. You may define a dynamic function like this:
+
+```clojure
+(defndynamic apply [f args] (cons f args))
+
+(apply '+ '(1 2)) ; => (+ 1 2)
+(apply 'Array.replicate '(5 "hello")) ; => (Array.replicate 5 "hello")
+```
+
+If you compare this code example to the macro example above, you’ll see that
+they are extremely similar, except for the invocation `defndynamic` and the
+quotes in their invocation.
+
+Macros also provide rest arguments; this basically means that you may define
+variadic macros by providing a “catch-all” argument as the last argument.
+
+```clojure
+(defmacro apply-or-sym [head :rest tail]
+  (if (= (length tail) 0)
+    head
+    (cons head tail)))
+
+(apply-or-sym *global*) ; => *global*
+(apply-or-sym + 1 2) ; => (+ 1 2)
+```
+
+The macro `apply-or-sym` is slightly ridiculous, but it should drive the point
+home. It takes one formal argument, `head`. You may provide any number of
+arguments after that—they will be bound to `tail`. Thus, tail will be a list of
+zero or more arguments. If we do not provide any, `apply-or-sym` will just
+return `head`. If we do, we treat it as a regular invocation. This kind of
+macro might look slightly silly, but rest assured that using rest arguments has
+many legitimate use cases.
+
+If you’d like to see more examples of macros big and small, you should now be
+equipped to understand a lot of the macros in [the standard
+library](/core/Macros.carp) and even [`fmt`](/core/Format.carp), a fairly
+complex piece of macro machinery.
+
+Some helpful functions for exploring macros in the REPL are `expand`, `eval`,
+and `macro-log`. `expand` will expand macros for you, while `eval` evaluates
+the resulting code. `macro-log` is useful for tracing your macro, a form of
+“printf debugging”.
+
+## Inner Workings
+
+The Carp compiler is split in a few different stages. The diagram below
+illustrates the flow of the compiler.
+
+![The compiler passes](./compiler-passes.svg)
+
+The dynamic evaluator is arguably one of the most central pieces of the Carp
+compiler. It orchestrates macro expansion, borrow checking, and type inference,
+as it encounters forms that have requirements for these services, such as
+function definitions, variables, or `let` bindings.
+
+Therefore, understanding the evaluator will give you a lot of insight into how
+Carp works generally.
+
+The most tried-and-true starting point for understanding the dynamic evaluator
+is `eval` in [`src/Eval.hs`](/src/Eval.hs).
+
+### Data Structures
+
+The type signature of `eval` is as follows:
+
+```haskell
+eval :: Context -> XObj -> IO (Context, Either EvalError XObj)
+```
+
+Thus, to understand it, we’ll have to understand at least `Context`, `XObj`,
+and `EvalError`. The types `IO` and `Either` are part of the Haskell standard
+library and will not be covered extensively—please refer to your favorite
+tool for Haskell documentation (we recommend [Stackage](https://stackage.org))
+to find out more about them.
+
+All data structures that are discussed here are defined in
+[`src/Obj.hs`](/src/Obj.hs).
+
+#### `XObj`
+
+`XObj` is short for “`Obj` with eXtras”. `Obj` is the type for AST nodes in
+Carp, and it’s used throughout the compiler. Most often, you’ll find it wrapped
+in an `XObj`, though, which annotates such an `Obj` with an optional source
+location information—in the field `info`, modelled as a `Maybe Info`—and
+type information—in the field `ty`, modelled as a `Maybe Ty`. While both of
+these fields are important, for the purposes of this document we will overlook
+them and treat a `XObj` as an ordinary AST node. Thus, `eval` becomes a
+function that takes a context and an AST node, and returns a pair consisting of
+a new context, and either an `EvalError` or a new AST node.
+
+#### `Context`
+
+`Context` is a data structure that holds all of the state of the Carp compiler.
+It is fairly extensive, holding information ranging from the type and value
+environments to the history of evaluation frames that were traversed for
+tracebacks.
+
+The entire state of the compiler should be inspectable by inspecting its
+context.
+
+#### `EvalError`
+
+An `EvalError` is emitted whenever the dynamic evaluator encounters an error.
+It consists of an error message and meta information (such as a traceback and
+source location information).
+
+### Evaluation
+
+The dynamic evaluator in Carp takes care both of evaluation and meta-level
+information like definitions. This means that definitions are treated much like
+dynamic primitives to evaluate rather than special constructs. In fact, many of
+them are not treated as special forms, but are implemented as `Primitive`s.
+
+Because we already introduced multiple constructs by name, let us define what
+kinds of Carp constructs there are for the evaluator:
+
+- Special forms: these are forms that have their own representation in the
+  abstract syntax tree and are treated directly in the evaluator loop. `fn` and
+  `the` are examples for this category. They cannot be passed around by value,
+  as you would do in higher order functions.
+- Primitives: these are regular Carp forms that do not evaluate their
+  arguments, and they resemble builtin macros implemented in Haskell. Examples
+  for this category include `defmacro`, `defn`, and `quote`. They can also not
+  be passed around by value, but this is considered a bug and should be
+  resolved.
+- Commands: these, too, are regular Carp forms. They evaluate their arguments
+  and behave like builtin functions. Examples for this category include
+  `Project.config`, `car`, and `cons`.
+
+Primitives are mostly defined in [`src/Primitives.hs`](/src/Primitives.hs),
+commands can be found in [`src/Commands.hs`](/src/Commands.hs), and special
+forms can be found directly inside `eval`.
+
+#### Adding your own special forms, primitives, or commands
+
+While there is a lot of machinery involved in getting your own primitives or
+commands into the Carp evaluator, there are a lot of simple functions around to
+help you get started.
+
+If the name for the primitive or command is already present as a runtime
+function, it should try to mimic its behavior as closely as possible.
+
+Adding special forms is a little more involved and we try to exercise caution
+in what to add, since every form makes `eval` harder to understand and reason
+about. You should probably get in touch [on the
+chat](https://gitter.im/carp-lang/carp) before embarking on a quest to
+implement a new special form to avoid frustration.
+
+#### A current list of special forms
+
+Since special forms are “magical”, they deserve an enumeration. Currently there
+are:
+
+- `if` for branching,
+- `defn` for defining functions,
+- `def` for defining global variables,
+- `let` for defining local variables,
+- `the` for type annotations,
+- `fn` for function literals.
+
+`Dynamic.or` and `Dynamic.and` are also currently special forms, but this is
+considered a bug and should be resolved.

docs/Manual.md

@@ -1,4 +1,5 @@
 ## The Compiler
+
 The Carp language is very tightly integrated with the REPL, everything you want to do to your program can be controlled from here.
 
 To explore the commands available, enter ```(help)``` and press enter.
@@ -23,6 +24,7 @@ There are a bunch of handy shortcuts for doing common things at the REPL:
 ```
 
 ### Differences compared to REPL:s in other Lisp:s
+
 While powerful, the REPL in Carp currently has some big limitations compared to most other Lisp:s. If you type in an expression and press enter one of the following things will happen:
 
 1. If you're calling a dynamic function (something defined with `defndynamic`, or a built in `command`) it will be executed right away. This works very much like a classic, dynamically typed Lisp interpreter. The dynamic functions are not available in compiled code! Their main usage is in macros and to programatically control your build settings.
@@ -32,6 +34,7 @@ While powerful, the REPL in Carp currently has some big limitations compared to
 3. If the top-level form isn't a function call, the REPL might get confused. For example, entering an array of calls to a Carp function will give unexpected results (the array will be dynamic but the function calls will not). The easiest way to work around that at the moment is to wrap the expression in a `defn` and call that one instead. This will be fixed in a future version of Carp.
 
 ### Adding annotations
+
 Carp has a flexible meta data system (inspired by the one in Clojure) that lets anyone add and retrieve data on the bindings in the environment. The general way to do that is with `(meta-set! <path> <key> <value>)` and `(meta <path> <key>)`.
 
 A couple of useful macros are implemented on top of this system:
@@ -51,16 +54,28 @@ To generate html docs from the doc strings, run:
 ```
 
 ### Getting types from bindings
+
 ```clojure
 鲮 (type <binding>)
+鲮 :t <binding>
 ```
 
 ### Listing bindings in a module
+
 ```clojure
 鲮 (info <module name>)
+鲮 :i <module name>
+```
+
+### Expanding a macro
+
+```clojure
+鲮 (expand 'yourcode)
+鲮 :m yourcode
 ```
 
 ### Configuring a project
+
 The current session in the repl is called a "project" and can be configured using the `(Project.config <setting> <value>)` command. The following settings can be configured with this command:
 
 * ```"cflag"```              - Add a flag to the compiler.
@@ -84,11 +99,13 @@ For example, to set the title of your project:
 ```
 
 ### Profile settings
-If a file called ```profile.carp``` is placed in the folder ```~/.carp/```, that file will get loaded after the compiler has started (after loading the core libraries but before any other source files are loaded). This file is meant for user specific settings that you want in all your projects, like little helper functions and other customizations.
 
-<!-- If a file called ```project.carp``` is placed in the folder where you invoke the ```carp``` command this file will get loaded after the compiler has started (and after 'user.carp' has loaded). This files is intended for setting up the build process of this particular project, for example by loading the correct source files, configuring the compiler variables, etc. -->
+If a file called ```profile.carp``` is placed in the XDG config folder ```carp/```, that file will get loaded after the compiler has started (after loading the core libraries but before any other source files are loaded). This file is meant for user specific settings that you want in all your projects, like little helper functions and other customizations.
+
+On Windows this file is located at ```C:/Users/USERNAME/AppData/Roaming/carp/profile.carp```.
 
 ### Compiler flags
+
 When invoking the compiler from the command line you can supply the following flags to configure the behaviour:
 
 * ```-b``` Build the code, then quit the compiler.
@@ -100,6 +117,7 @@ When invoking the compiler from the command line you can supply the following fl
 * ```--generate-only``` Don't compile the C source.
 
 ### Inspecting the C code generated by an expression
+
 ```clojure
 鲮 (c '(+ 2 3))
 ```

docs/compiler-passes.drawio

@@ -0,0 +1 @@
+<mxfile host="app.diagrams.net" modified="2020-04-17T14:35:47.523Z" agent="5.0 (Macintosh)" etag="5WsT60d9nrPWs3CUyhgw" version="12.9.14" type="device"><diagram id="rg3h2TteFwrlMeGAYia9" name="Page-1">3VnbcpswEP0aP6YDiJsfU9tN20maTNOZNo8yrI1qQIyQL/TrK4wwF/mW2C5xXzzooEXi7J5lV+6hQbS6YzgJHqgPYc/Q/FUPDXuG0Tdt8ZsDWQHYplYAU0b8AtIr4Jn8AQmW0+bEh7QxkVMacpI0QY/GMXi8gWHG6LI5bULD5qoJnoICPHs4VNGfxOdBgTrlW+T4ZyDTQK5saPJGhMu5EkgD7NNlDUKjHhowSnlxFa0GEObUlbQUdp923N3si0HMjzHI7qJvzpgMLWxPgvT7w9fJR3ZTsrzA4Vy+sNwtz0oGwBeEyCFlPKBTGuNwVKEfGZ3HPuTraGJUzbmnNBGgLsDfwHkmvYvnnAoo4FEo7xZr5gvtfDkJpXTOPNj3RjJGMJsC3zMPbVwgIhdoBJxlwo5BiDlZNPeBZQxNN/MqnsWFpPo1tCusP2GWAlO4r5jNaVoGhMNzgtcELIXcmixOSBgOaEjZ2hb5Fri+KfCUMzqD2h3XGCPb3vC+AMZhtZ95lanSoFSC1LfuyvGyUoteaiCoKaW0Ozu5hkLucxE0hjYQ2UnhWAgzyS9jyuEwyWPszaZrtzzOeUhikLiP2exRWBGeE6F90KwtHsHgTrxtHrE9F8aT83jEaDnEUh3ibPGHrl3KIbr9hpzizdliE/hvSCmwIvzX2hOWHL3I/JRfD1f1QSYHZ0xD6Mg0ZJ6Yhtamt4zhrDYhoSTmae3JTzlQRQiyt2u2cnLxxMrlm62dIEv93USBvjcKhK9ZVhjZmlsCL5Wq1+PKdj1qGD8BI4IuYN3Fld1JXLmoEVetkuRCcYU6jCu9nls2MXYorpoxdSikOogep8viCCnf72EW44h4AhzlKOb0GislpL+3Skl3riQln1ECZ/ngbsl8O3xbPqKQnLSq3Pb6DNtaB7WaviP3ddGMbCoC/pElefn9JZ6A8Jin1uDXp95+1+J9U6feRVVdq6dMkXFq3z6942LKPvJzeOpZwVmK9LJpu6h0bUW692QCXDigKV+xFRtHuS6LX4GIcGJ0mTfZAXgzEk//A5FvGuXuVG5eW3V7I7ok1JC50H2/Y6U7Ryrd7bLwdRTxFedV2igiaUpofIWKMncVRp0pylVYHq3Am3M8DnefDXqY+a9n+J8c99nWezvv6ysMqzks9m/XnwtBbYhFcHutDNR9r2wcmTJ2eKfGvrWF/RI7se8w2yd5TsupxWsqfYfyIKvdnBrHNTCHCw8xrP7kKqZXfxSi0V8=</diagram></mxfile>

docs/core/Array.html

@@ -97,6 +97,11 @@
                                 Array
                             </a>
                         </li>
+                        <li>
+                            <a href="StaticArray.html">
+                                StaticArray
+                            </a>
+                        </li>
                         <li>
                             <a href="IO.html">
                                 IO

docs/core/Bench.html

@@ -97,6 +97,11 @@
                                 Array
                             </a>
                         </li>
+                        <li>
+                            <a href="StaticArray.html">
+                                StaticArray
+                            </a>
+                        </li>
                         <li>
                             <a href="IO.html">
                                 IO

docs/core/Bool.html

@@ -97,6 +97,11 @@
                                 Array
                             </a>
                         </li>
+                        <li>
+                            <a href="StaticArray.html">
+                                StaticArray
+                            </a>
+                        </li>
                         <li>
                             <a href="IO.html">
                                 IO

docs/core/Byte.html

@@ -97,6 +97,11 @@
                                 Array
                             </a>
                         </li>
+                        <li>
+                            <a href="StaticArray.html">
+                                StaticArray
+                            </a>
+                        </li>
                         <li>
                             <a href="IO.html">
                                 IO

docs/core/Char.html

@@ -97,6 +97,11 @@
                                 Array
                             </a>
                         </li>
+                        <li>
+                            <a href="StaticArray.html">
+                                StaticArray
+                            </a>
+                        </li>
                         <li>
                             <a href="IO.html">
                                 IO

docs/core/Debug.html

@@ -97,6 +97,11 @@
                                 Array
                             </a>
                         </li>
+                        <li>
+                            <a href="StaticArray.html">
+                                StaticArray
+                            </a>
+                        </li>
                         <li>
                             <a href="IO.html">
                                 IO

docs/core/Double.html

@@ -97,6 +97,11 @@
                                 Array
                             </a>
                         </li>
+                        <li>
+                            <a href="StaticArray.html">
+                                StaticArray
+                            </a>
+                        </li>
                         <li>
                             <a href="IO.html">
                                 IO

docs/core/Dynamic.html

@@ -97,6 +97,11 @@
                                 Array
                             </a>
                         </li>
+                        <li>
+                            <a href="StaticArray.html">
+                                StaticArray
+                            </a>
+                        </li>
                         <li>
                             <a href="IO.html">
                                 IO
@@ -361,6 +366,25 @@
                     
                 </p>
             </div>
+            <div class="binder">
+                <a class="anchor" href="#and-internal">
+                    <h3 id="and-internal">
+                        and-internal
+                    </h3>
+                </a>
+                <div class="description">
+                    dynamic
+                </div>
+                <p class="sig">
+                    Dynamic
+                </p>
+                <pre class="args">
+                    (and-internal x y)
+                </pre>
+                <p class="doc">
+                    
+                </p>
+            </div>
             <div class="binder">
                 <a class="anchor" href="#append">
                     <h3 id="append">
@@ -380,6 +404,27 @@
                     
                 </p>
             </div>
+            <div class="binder">
+                <a class="anchor" href="#apply">
+                    <h3 id="apply">
+                        apply
+                    </h3>
+                </a>
+                <div class="description">
+                    dynamic
+                </div>
+                <p class="sig">
+                    Dynamic
+                </p>
+                <pre class="args">
+                    (apply f argument-list)
+                </pre>
+                <p class="doc">
+                    <p>Applies the function <code>f</code> to the provided argument list, passing each value
+in the list as an argument to the function.</p>
+
+                </p>
+            </div>
             <div class="binder">
                 <a class="anchor" href="#array">
                     <h3 id="array">
@@ -1084,6 +1129,48 @@
                     
                 </p>
             </div>
+            <div class="binder">
+                <a class="anchor" href="#compose">
+                    <h3 id="compose">
+                        compose
+                    </h3>
+                </a>
+                <div class="description">
+                    dynamic
+                </div>
+                <p class="sig">
+                    Dynamic
+                </p>
+                <pre class="args">
+                    (compose f g)
+                </pre>
+                <p class="doc">
+                    <p>Returns the composition of two functions <code>f</code> and <code>g</code> for functions of any
+airity; concretely, returns a function accepting the correct number of
+arguments for <code>g</code>, applies <code>g</code> to those arguments, then applies <code>f</code> to the
+result.</p>
+<pre><code>If you only need to compose functions that take a single argument (unary arity)
+see `comp`. Comp also generates the form that corresponds to the composition,
+compose contrarily evaluates 'eagerly' and returns a computed symbol.
+
+For exmaple:
+
+```
+;; a silly composition
+((compose empty take) 3 [1 2 3 4 5])
+;; =&gt; []
+
+(String.join (collect-into ((compose reverse map) Symbol.str '(p r a c)) array))
+;; =&gt; 'carp'
+
+;; comp for comparison
+((comp (curry + 1) (curry + 2)) 4)
+;; =&gt; (+ 1 (+ 2 4))
+```
+</code></pre>
+
+                </p>
+            </div>
             <div class="binder">
                 <a class="anchor" href="#cons">
                     <h3 id="cons">
@@ -1122,6 +1209,68 @@
                     
                 </p>
             </div>
+            <div class="binder">
+                <a class="anchor" href="#curry">
+                    <h3 id="curry">
+                        curry
+                    </h3>
+                </a>
+                <div class="description">
+                    dynamic
+                </div>
+                <p class="sig">
+                    Dynamic
+                </p>
+                <pre class="args">
+                    (curry f x)
+                </pre>
+                <p class="doc">
+                    <p>Returns a curried function accepting a single argument, that applies f to x
+and then to the following argument.</p>
+<pre><code>For example,
+
+```
+(map (curry Symbol.prefix 'Foo) '(bar baz))
+;; =&gt; (Foo.bar Foo.baz)
+```
+</code></pre>
+
+                </p>
+            </div>
+            <div class="binder">
+                <a class="anchor" href="#curry*">
+                    <h3 id="curry*">
+                        curry*
+                    </h3>
+                </a>
+                <div class="description">
+                    dynamic
+                </div>
+                <p class="sig">
+                    Dynamic
+                </p>
+                <pre class="args">
+                    (curry* f :rest args)
+                </pre>
+                <p class="doc">
+                    <p>Curry functions of any airity.</p>
+<pre><code> For example:
+
+ ```
+ (map (curry* Dynamic.zip + '(1 2 3)) '((4 5) (6)))
+ ;; =&gt; (((+ 1 4) (+ 2 5)) ((+ 1 6)))
+
+ ((curry Dynamic.zip cons '(1 2 3)) '((4 5) (6)))
+ ;; =&gt; ((cons 1 (4 5)) (cons (2 (6))))
+
+ (defndynamic add-em-up [x y z] (+ (+ x y) z))
+ (map (curry* add-em-up 1 2) '(1 2 3))
+ ;; =&gt; (4 5 6)
+ ```
+</code></pre>
+
+                </p>
+            </div>
             <div class="binder">
                 <a class="anchor" href="#cxr">
                     <h3 id="cxr">
@@ -1179,6 +1328,55 @@
                     
                 </p>
             </div>
+            <div class="binder">
+                <a class="anchor" href="#empty">
+                    <h3 id="empty">
+                        empty
+                    </h3>
+                </a>
+                <div class="description">
+                    dynamic
+                </div>
+                <p class="sig">
+                    Dynamic
+                </p>
+                <pre class="args">
+                    (empty xs)
+                </pre>
+                <p class="doc">
+                    <p>Returns the empty form of <code>xs</code>.</p>
+<pre><code> For example:
+
+ ```
+ (empty '(1 2 3 4))
+ ;; =&gt; ()
+ (empty '[1 2 3 4])
+ ;; =&gt; []
+ ```
+</code></pre>
+
+                </p>
+            </div>
+            <div class="binder">
+                <a class="anchor" href="#empty?">
+                    <h3 id="empty?">
+                        empty?
+                    </h3>
+                </a>
+                <div class="description">
+                    dynamic
+                </div>
+                <p class="sig">
+                    Dynamic
+                </p>
+                <pre class="args">
+                    (empty? xs)
+                </pre>
+                <p class="doc">
+                    <p>Returns true if the provided data literal is empty, false otherwise.</p>
+
+                </p>
+            </div>
             <div class="binder">
                 <a class="anchor" href="#env">
                     <h3 id="env">
@@ -1198,25 +1396,6 @@
                     
                 </p>
             </div>
-            <div class="binder">
-                <a class="anchor" href="#eval">
-                    <h3 id="eval">
-                        eval
-                    </h3>
-                </a>
-                <div class="description">
-                    macro
-                </div>
-                <p class="sig">
-                    Macro
-                </p>
-                <pre class="args">
-                    (eval form)
-                </pre>
-                <p class="doc">
-                    
-                </p>
-            </div>
             <div class="binder">
                 <a class="anchor" href="#eval-internal">
                     <h3 id="eval-internal">
@@ -1236,6 +1415,25 @@
                     
                 </p>
             </div>
+            <div class="binder">
+                <a class="anchor" href="#evaluate">
+                    <h3 id="evaluate">
+                        evaluate
+                    </h3>
+                </a>
+                <div class="description">
+                    macro
+                </div>
+                <p class="sig">
+                    Macro
+                </p>
+                <pre class="args">
+                    (evaluate form)
+                </pre>
+                <p class="doc">
+                    
+                </p>
+            </div>
             <div class="binder">
                 <a class="anchor" href="#expand">
                     <h3 id="expand">
@@ -1255,6 +1453,60 @@
                     
                 </p>
             </div>
+            <div class="binder">
+                <a class="anchor" href="#filter">
+                    <h3 id="filter">
+                        filter
+                    </h3>
+                </a>
+                <div class="description">
+                    dynamic
+                </div>
+                <p class="sig">
+                    Dynamic
+                </p>
+                <pre class="args">
+                    (filter p xs)
+                </pre>
+                <p class="doc">
+                    <p>Returns a list containing only the elements of <code>xs</code> that satisify predicate <code>p</code>.</p>
+<pre><code> For example:
+
+ ```
+ (filter (fn [x] (= 'a x)) '(a b a b a b a b))
+ ;; =&gt; (a a a a)
+ ```
+</code></pre>
+
+                </p>
+            </div>
+            <div class="binder">
+                <a class="anchor" href="#flip">
+                    <h3 id="flip">
+                        flip
+                    </h3>
+                </a>
+                <div class="description">
+                    dynamic
+                </div>
+                <p class="sig">
+                    Dynamic
+                </p>
+                <pre class="args">
+                    (flip f)
+                </pre>
+                <p class="doc">
+                    <p>Flips the arguments of a function <code>f</code>.</p>
+<pre><code>For example,
+
+```
+((flip Symbol.prefix) 'Bar 'Foo)
+=&gt; ;; (Foo.Bar)
+```
+</code></pre>
+
+                </p>
+            </div>
             <div class="binder">
                 <a class="anchor" href="#help">
                     <h3 id="help">
@@ -1445,6 +1697,56 @@
                     
                 </p>
             </div>
+            <div class="binder">
+                <a class="anchor" href="#map">
+                    <h3 id="map">
+                        map
+                    </h3>
+                </a>
+                <div class="description">
+                    dynamic
+                </div>
+                <p class="sig">
+                    Dynamic
+                </p>
+                <pre class="args">
+                    (map f xs)
+                </pre>
+                <p class="doc">
+                    <p>Applies a function <code>f</code> to each element in the list or array <code>xs</code> and
+returns a list dynamic data literal containing the result of the function
+applications.</p>
+<pre><code> For example:
+  ```clojure
+  '(map symbol? '(a b c))
+  =&gt; (true true true)
+  '(map (curry + 1) '(1 2 3))
+  =&gt; (2 3 4)
+  ```
+</code></pre>
+
+                </p>
+            </div>
+            <div class="binder">
+                <a class="anchor" href="#no-echo">
+                    <h3 id="no-echo">
+                        no-echo
+                    </h3>
+                </a>
+                <div class="description">
+                    doc-stub
+                </div>
+                <p class="sig">
+                    a
+                </p>
+                <span>
+                    
+                </span>
+                <p class="doc">
+                    <p>Turn off debug printing in the compiler.</p>
+
+                </p>
+            </div>
             <div class="binder">
                 <a class="anchor" href="#not">
                     <h3 id="not">
@@ -1502,6 +1804,25 @@
                     
                 </p>
             </div>
+            <div class="binder">
+                <a class="anchor" href="#or-internal">
+                    <h3 id="or-internal">
+                        or-internal
+                    </h3>
+                </a>
+                <div class="description">
+                    dynamic
+                </div>
+                <p class="sig">
+                    Dynamic
+                </p>
+                <pre class="args">
+                    (or-internal x y)
+                </pre>
+                <p class="doc">
+                    
+                </p>
+            </div>
             <div class="binder">
                 <a class="anchor" href="#os">
                     <h3 id="os">
@@ -1559,6 +1880,25 @@
                     
                 </p>
             </div>
+            <div class="binder">
+                <a class="anchor" href="#quoted">
+                    <h3 id="quoted">
+                        quoted
+                    </h3>
+                </a>
+                <div class="description">
+                    dynamic
+                </div>
+                <p class="sig">
+                    Dynamic
+                </p>
+                <pre class="args">
+                    (quoted x)
+                </pre>
+                <p class="doc">
+                    
+                </p>
+            </div>
             <div class="binder">
                 <a class="anchor" href="#read-file">
                     <h3 id="read-file">
@@ -1578,6 +1918,27 @@
                     
                 </p>
             </div>
+            <div class="binder">
+                <a class="anchor" href="#reduce">
+                    <h3 id="reduce">
+                        reduce
+                    </h3>
+                </a>
+                <div class="description">
+                    dynamic
+                </div>
+                <p class="sig">
+                    Dynamic
+                </p>
+                <pre class="args">
+                    (reduce f x xs)
+                </pre>
+                <p class="doc">
+                    <p>Reduces or 'folds' a data literal, such as a list or array, into a single
+value through successive applications of <code>f</code>.</p>
+
+                </p>
+            </div>
             <div class="binder">
                 <a class="anchor" href="#relative-include">
                     <h3 id="relative-include">
@@ -1616,6 +1977,33 @@
                     
                 </p>
             </div>
+            <div class="binder">
+                <a class="anchor" href="#reverse">
+                    <h3 id="reverse">
+                        reverse
+                    </h3>
+                </a>
+                <div class="description">
+                    dynamic
+                </div>
+                <p class="sig">
+                    Dynamic
+                </p>
+                <pre class="args">
+                    (reverse xs)
+                </pre>
+                <p class="doc">
+                    <p>Reverses the order of elements in an array or list.</p>
+<pre><code> For example:
+
+ ```
+ (reverse [1 2 3 4])
+ ;; =&gt; [4 3 2 1]
+ ```
+</code></pre>
+
+                </p>
+            </div>
             <div class="binder">
                 <a class="anchor" href="#run">
                     <h3 id="run">
@@ -1711,6 +2099,62 @@
                     
                 </p>
             </div>
+            <div class="binder">
+                <a class="anchor" href="#take">
+                    <h3 id="take">
+                        take
+                    </h3>
+                </a>
+                <div class="description">
+                    dynamic
+                </div>
+                <p class="sig">
+                    Dynamic
+                </p>
+                <pre class="args">
+                    (take n xs)
+                </pre>
+                <p class="doc">
+                    <p>Returns a list containing the first <code>n</code> eleements of a list.</p>
+<pre><code> For example:
+
+ ```
+ (take 3 '(1 2 3 4 5))
+ ;; =&gt; (1 2 3)
+ ```
+</code></pre>
+
+                </p>
+            </div>
+            <div class="binder">
+                <a class="anchor" href="#unreduce">
+                    <h3 id="unreduce">
+                        unreduce
+                    </h3>
+                </a>
+                <div class="description">
+                    dynamic
+                </div>
+                <p class="sig">
+                    Dynamic
+                </p>
+                <pre class="args">
+                    (unreduce f x lim acc)
+                </pre>
+                <p class="doc">
+                    <p>Applies <code>f</code> to a starting value <code>x</code>, then generates a sequence of values
+by successively applying <code>f</code> to the result <code>lim-1</code> times.
+Collects results in the structure given by <code>acc</code>.</p>
+<pre><code> For example:
+
+ ```
+ (unreduce (curry + 1) 0 10 (list))
+ ;; =&gt; (1 2 3 4 5 6 7 8 9 10)
+ ```
+</code></pre>
+
+                </p>
+            </div>
             <div class="binder">
                 <a class="anchor" href="#write-file">
                     <h3 id="write-file">
@@ -1728,6 +2172,50 @@
                 </span>
                 <p class="doc">
                     
+                </p>
+            </div>
+            <div class="binder">
+                <a class="anchor" href="#zip">
+                    <h3 id="zip">
+                        zip
+                    </h3>
+                </a>
+                <div class="description">
+                    dynamic
+                </div>
+                <p class="sig">
+                    Dynamic
+                </p>
+                <pre class="args">
+                    (zip f :rest forms)
+                </pre>
+                <p class="doc">
+                    <p>Returns the <em>form</em> that results from applying  a function <code>f</code> to each of
+the values supplied in <code>forms</code>.</p>
+<pre><code>If the members of a single form are exhuasted, the result of the
+applications thus far is returned, and any remaining members in the other
+forms are ignored.
+
+For example,
+
+```
+(zip + '(1 2 3) '(4 5 6))
+;; =&gt; ((+ 1 4) (+ 2 5) (+ 3 6))
+```
+
+It's important to note that zip operates on forms, and that the form
+returned by zip may not be evaluable by itself. For instance, to actually
+transform the result in the example above into something Carp can
+evaluate, we need to wrap each member of the list in a `do`:
+
+```
+(append (list 'do) (zip + '(1 2 3) '(4 5 6)))
+;; =&gt; (do (+ 1 4) (+ 2 5) (+ 3 6))
+(eval (append (list 'do) (zip + '(1 2 3) '(4 5 6))))
+;; =&gt; 9 ;; do returns the value of the last form in its body
+```
+</code></pre>
+
                 </p>
             </div>
         </div>

docs/core/Float.html

@@ -97,6 +97,11 @@
                                 Array
                             </a>
                         </li>
+                        <li>
+                            <a href="StaticArray.html">
+                                StaticArray
+                            </a>
+                        </li>
                         <li>
                             <a href="IO.html">
                                 IO

docs/core/Geometry.html

@@ -97,6 +97,11 @@
                                 Array
                             </a>
                         </li>
+                        <li>
+                            <a href="StaticArray.html">
+                                StaticArray
+                            </a>
+                        </li>
                         <li>
                             <a href="IO.html">
                                 IO

docs/core/IO.html

@@ -97,6 +97,11 @@
                                 Array
                             </a>
                         </li>
+                        <li>
+                            <a href="StaticArray.html">
+                                StaticArray
+                            </a>
+                        </li>
                         <li>
                             <a href="IO.html">
                                 IO

docs/core/Int.html

@@ -97,6 +97,11 @@
                                 Array
                             </a>
                         </li>
+                        <li>
+                            <a href="StaticArray.html">
+                                StaticArray
+                            </a>
+                        </li>
                         <li>
                             <a href="IO.html">
                                 IO

docs/core/Long.html

@@ -97,6 +97,11 @@
                                 Array
                             </a>
                         </li>
+                        <li>
+                            <a href="StaticArray.html">
+                                StaticArray
+                            </a>
+                        </li>
                         <li>
                             <a href="IO.html">
                                 IO

docs/core/Map.html

@@ -97,6 +97,11 @@
                                 Array
                             </a>
                         </li>
+                        <li>
+                            <a href="StaticArray.html">
+                                StaticArray
+                            </a>
+                        </li>
                         <li>
                             <a href="IO.html">
                                 IO

docs/core/Maybe.html

@@ -97,6 +97,11 @@
                                 Array
                             </a>
                         </li>
+                        <li>
+                            <a href="StaticArray.html">
+                                StaticArray
+                            </a>
+                        </li>
                         <li>
                             <a href="IO.html">
                                 IO

docs/core/Pattern.html

@@ -97,6 +97,11 @@
                                 Array
                             </a>
                         </li>
+                        <li>
+                            <a href="StaticArray.html">
+                                StaticArray
+                            </a>
+                        </li>
                         <li>
                             <a href="IO.html">
                                 IO

docs/core/Pointer.html

@@ -97,6 +97,11 @@
                                 Array
                             </a>
                         </li>
+                        <li>
+                            <a href="StaticArray.html">
+                                StaticArray
+                            </a>
+                        </li>
                         <li>
                             <a href="IO.html">
                                 IO
@@ -329,6 +334,26 @@
 
                 </p>
             </div>
+            <div class="binder">
+                <a class="anchor" href="#to-value">
+                    <h3 id="to-value">
+                        to-value
+                    </h3>
+                </a>
+                <div class="description">
+                    template
+                </div>
+                <p class="sig">
+                    (λ [(Ptr a)] a)
+                </p>
+                <span>
+                    
+                </span>
+                <p class="doc">
+                    <p>converts a pointer to a value. The user will have to ensure themselves that this is a safe operation.</p>
+
+                </p>
+            </div>
             <div class="binder">
                 <a class="anchor" href="#width">
                     <h3 id="width">

docs/core/Result.html

@@ -97,6 +97,11 @@
                                 Array
                             </a>
                         </li>
+                        <li>
+                            <a href="StaticArray.html">
+                                StaticArray
+                            </a>
+                        </li>
                         <li>
                             <a href="IO.html">
                                 IO

docs/core/StaticArray.html

@@ -0,0 +1,358 @@
+<!DOCTYPE HTML>
+
+<html>
+    <head>
+        <meta charset="UTF-8">
+        <meta name="viewport" content="width=device-width, initial-scale=1.0, maximum-scale=1.0, user-scalable=0">
+        <link rel="stylesheet" href="carp_style.css">
+    </head>
+    <body>
+        <div class="content">
+            <div class="logo">
+                <a href="http://github.com/carp-lang/Carp">
+                    <img src="logo.png">
+                </a>
+                <div class="title">
+                    core
+                </div>
+                <div class="index">
+                    <ul>
+                        <li>
+                            <a href="Dynamic.html">
+                                Dynamic
+                            </a>
+                        </li>
+                        <li>
+                            <a href="Int.html">
+                                Int
+                            </a>
+                        </li>
+                        <li>
+                            <a href="Byte.html">
+                                Byte
+                            </a>
+                        </li>
+                        <li>
+                            <a href="Long.html">
+                                Long
+                            </a>
+                        </li>
+                        <li>
+                            <a href="Bool.html">
+                                Bool
+                            </a>
+                        </li>
+                        <li>
+                            <a href="Float.html">
+                                Float
+                            </a>
+                        </li>
+                        <li>
+                            <a href="Double.html">
+                                Double
+                            </a>
+                        </li>
+                        <li>
+                            <a href="Vector2.html">
+                                Vector2
+                            </a>
+                        </li>
+                        <li>
+                            <a href="Vector3.html">
+                                Vector3
+                            </a>
+                        </li>
+                        <li>
+                            <a href="VectorN.html">
+                                VectorN
+                            </a>
+                        </li>
+                        <li>
+                            <a href="Geometry.html">
+                                Geometry
+                            </a>
+                        </li>
+                        <li>
+                            <a href="Statistics.html">
+                                Statistics
+                            </a>
+                        </li>
+                        <li>
+                            <a href="String.html">
+                                String
+                            </a>
+                        </li>
+                        <li>
+                            <a href="Char.html">
+                                Char
+                            </a>
+                        </li>
+                        <li>
+                            <a href="Pattern.html">
+                                Pattern
+                            </a>
+                        </li>
+                        <li>
+                            <a href="Array.html">
+                                Array
+                            </a>
+                        </li>
+                        <li>
+                            <a href="StaticArray.html">
+                                StaticArray
+                            </a>
+                        </li>
+                        <li>
+                            <a href="IO.html">
+                                IO
+                            </a>
+                        </li>
+                        <li>
+                            <a href="System.html">
+                                System
+                            </a>
+                        </li>
+                        <li>
+                            <a href="Debug.html">
+                                Debug
+                            </a>
+                        </li>
+                        <li>
+                            <a href="Test.html">
+                                Test
+                            </a>
+                        </li>
+                        <li>
+                            <a href="Bench.html">
+                                Bench
+                            </a>
+                        </li>
+                        <li>
+                            <a href="Map.html">
+                                Map
+                            </a>
+                        </li>
+                        <li>
+                            <a href="Maybe.html">
+                                Maybe
+                            </a>
+                        </li>
+                        <li>
+                            <a href="Result.html">
+                                Result
+                            </a>
+                        </li>
+                        <li>
+                            <a href="Pointer.html">
+                                Pointer
+                            </a>
+                        </li>
+                    </ul>
+                </div>
+            </div>
+            <h1>
+                StaticArray
+            </h1>
+            <div class="module-description">
+                
+            </div>
+            <div class="binder">
+                <a class="anchor" href="#=">
+                    <h3 id="=">
+                        =
+                    </h3>
+                </a>
+                <div class="description">
+                    defn
+                </div>
+                <p class="sig">
+                    (λ [(Ref (StaticArray a) b), (Ref (StaticArray a) b)] Bool)
+                </p>
+                <pre class="args">
+                    (= a b)
+                </pre>
+                <p class="doc">
+                    <p>compares two static arrays.</p>
+
+                </p>
+            </div>
+            <div class="binder">
+                <a class="anchor" href="#aset!">
+                    <h3 id="aset!">
+                        aset!
+                    </h3>
+                </a>
+                <div class="description">
+                    template
+                </div>
+                <p class="sig">
+                    (λ [(Ref (StaticArray a) b), Int, a] ())
+                </p>
+                <span>
+                    
+                </span>
+                <p class="doc">
+                    <p>sets a static array element at the index <code>n</code> to a new value in place.</p>
+
+                </p>
+            </div>
+            <div class="binder">
+                <a class="anchor" href="#delete">
+                    <h3 id="delete">
+                        delete
+                    </h3>
+                </a>
+                <div class="description">
+                    template
+                </div>
+                <p class="sig">
+                    (λ [(StaticArray a)] ())
+                </p>
+                <span>
+                    
+                </span>
+                <p class="doc">
+                    <p>deletes a static array. This function should not be called manually (there shouldn't be a way to create value types of type StaticArray).</p>
+
+                </p>
+            </div>
+            <div class="binder">
+                <a class="anchor" href="#foreach">
+                    <h3 id="foreach">
+                        foreach
+                    </h3>
+                </a>
+                <div class="description">
+                    macro
+                </div>
+                <p class="sig">
+                    Macro
+                </p>
+                <pre class="args">
+                    (foreach binding expr)
+                </pre>
+                <p class="doc">
+                    
+                </p>
+            </div>
+            <div class="binder">
+                <a class="anchor" href="#foreach-internal">
+                    <h3 id="foreach-internal">
+                        foreach-internal
+                    </h3>
+                </a>
+                <div class="description">
+                    dynamic
+                </div>
+                <p class="sig">
+                    Dynamic
+                </p>
+                <pre class="args">
+                    (foreach-internal var xs expr)
+                </pre>
+                <p class="doc">
+                    
+                </p>
+            </div>
+            <div class="binder">
+                <a class="anchor" href="#length">
+                    <h3 id="length">
+                        length
+                    </h3>
+                </a>
+                <div class="description">
+                    template
+                </div>
+                <p class="sig">
+                    (λ [(Ref (StaticArray a) b)] Int)
+                </p>
+                <span>
+                    
+                </span>
+                <p class="doc">
+                    <p>gets the length of the static array.</p>
+
+                </p>
+            </div>
+            <div class="binder">
+                <a class="anchor" href="#map!">
+                    <h3 id="map!">
+                        map!
+                    </h3>
+                </a>
+                <div class="description">
+                    defn
+                </div>
+                <p class="sig">
+                    (λ [(Ref (StaticArray a) b), (Ref (λ [(Ref a b)] a c) d)] ())
+                </p>
+                <pre class="args">
+                    (map! xs f)
+                </pre>
+                <p class="doc">
+                    <p>Maps a function over the static array <code>xs</code>, mutating it in place. The difference to Array.endo-map (which does the same thing internally) is that this function takes a ref (since you can never have static arrays as values) and that it returns ().</p>
+
+                </p>
+            </div>
+            <div class="binder">
+                <a class="anchor" href="#reduce">
+                    <h3 id="reduce">
+                        reduce
+                    </h3>
+                </a>
+                <div class="description">
+                    defn
+                </div>
+                <p class="sig">
+                    (λ [(Ref (λ [a, (Ref b c)] a d) e), a, (Ref (StaticArray b) c)] a)
+                </p>
+                <pre class="args">
+                    (reduce f x xs)
+                </pre>
+                <p class="doc">
+                    
+                </p>
+            </div>
+            <div class="binder">
+                <a class="anchor" href="#str">
+                    <h3 id="str">
+                        str
+                    </h3>
+                </a>
+                <div class="description">
+                    template
+                </div>
+                <p class="sig">
+                    (λ [(Ref (StaticArray a) b)] String)
+                </p>
+                <span>
+                    
+                </span>
+                <p class="doc">
+                    <p>converts a static array to a string.</p>
+
+                </p>
+            </div>
+            <div class="binder">
+                <a class="anchor" href="#unsafe-nth">
+                    <h3 id="unsafe-nth">
+                        unsafe-nth
+                    </h3>
+                </a>
+                <div class="description">
+                    template
+                </div>
+                <p class="sig">
+                    (λ [(Ref (StaticArray a) b), Int] (Ref a b))
+                </p>
+                <span>
+                    
+                </span>
+                <p class="doc">
+                    <p>gets a reference to the <code>n</code>th element from a static array <code>a</code>.</p>
+
+                </p>
+            </div>
+        </div>
+    </body>
+</html>

docs/core/Statistics.html

@@ -97,6 +97,11 @@
                                 Array
                             </a>
                         </li>
+                        <li>
+                            <a href="StaticArray.html">
+                                StaticArray
+                            </a>
+                        </li>
                         <li>
                             <a href="IO.html">
                                 IO

docs/core/String.html

@@ -97,6 +97,11 @@
                                 Array
                             </a>
                         </li>
+                        <li>
+                            <a href="StaticArray.html">
+                                StaticArray
+                            </a>
+                        </li>
                         <li>
                             <a href="IO.html">
                                 IO

docs/core/System.html

@@ -97,6 +97,11 @@
                                 Array
                             </a>
                         </li>
+                        <li>
+                            <a href="StaticArray.html">
+                                StaticArray
+                            </a>
+                        </li>
                         <li>
                             <a href="IO.html">
                                 IO

docs/core/Test.html

@@ -97,6 +97,11 @@
                                 Array
                             </a>
                         </li>
+                        <li>
+                            <a href="StaticArray.html">
+                                StaticArray
+                            </a>
+                        </li>
                         <li>
                             <a href="IO.html">
                                 IO
@@ -206,7 +211,7 @@
                     (assert-exit state exit-code f descr)
                 </pre>
                 <p class="doc">
-                    <p>Assert that function f aborts with OS signal signal.</p>
+                    <p>Assert that function f exits with exit code exit-code.</p>
 
                 </p>
             </div>
@@ -286,7 +291,8 @@
                     (assert-signal state signal x descr)
                 </pre>
                 <p class="doc">
-                    
+                    <p>Assert that function f aborts with OS signal signal.</p>
+
                 </p>
             </div>
             <div class="binder">

docs/core/Vector2.html

@@ -97,6 +97,11 @@
                                 Array
                             </a>
                         </li>
+                        <li>
+                            <a href="StaticArray.html">
+                                StaticArray
+                            </a>
+                        </li>
                         <li>
                             <a href="IO.html">
                                 IO

docs/core/Vector3.html

@@ -97,6 +97,11 @@
                                 Array
                             </a>
                         </li>
+                        <li>
+                            <a href="StaticArray.html">
+                                StaticArray
+                            </a>
+                        </li>
                         <li>
                             <a href="IO.html">
                                 IO

docs/core/VectorN.html

@@ -97,6 +97,11 @@
                                 Array
                             </a>
                         </li>
+                        <li>
+                            <a href="StaticArray.html">
+                                StaticArray
+                            </a>
+                        </li>
                         <li>
                             <a href="IO.html">
                                 IO

docs/core/core_index.html

@@ -93,6 +93,11 @@
                                     Array
                                 </a>
                             </li>
+                            <li>
+                                <a href="StaticArray.html">
+                                    StaticArray
+                                </a>
+                            </li>
                             <li>
                                 <a href="IO.html">
                                     IO

docs/core/generate_core_docs.carp

@@ -27,6 +27,7 @@
            Char
            Pattern
            Array
+           StaticArray
            IO
            System
            Debug

docs/sdl/IMG.html

@@ -55,25 +55,6 @@
             </h1>
             <div class="module-description">
                 
-            </div>
-            <div class="binder">
-                <a class="anchor" href="#Windows">
-                    <h3 id="Windows">
-                        Windows
-                    </h3>
-                </a>
-                <div class="description">
-                    module
-                </div>
-                <p class="sig">
-                    Module
-                </p>
-                <span>
-                    
-                </span>
-                <p class="doc">
-                    
-                </p>
             </div>
             <div class="binder">
                 <a class="anchor" href="#load">

examples/static_array.carp

@@ -0,0 +1,4 @@
+(defn main []
+  (let-do [xs $[1 2 3 4 5]]
+    (StaticArray.map! xs &(fn [x] (* @x 2)))
+    (println* (StaticArray.reduce &(fn [total x] (+ total @x)) 0 xs))))

run_carp_tests.ps1

@@ -0,0 +1,37 @@
+# Stops script if there is an error
+Set-StrictMode -Version Latest
+$ErrorActionPreference = "Stop"
+$PSDefaultParameterValues['*:ErrorAction']='Stop'
+
+function exitOnError {
+  param([scriptblock]$ScriptBlock)
+  & @ScriptBlock
+  if ($lastexitcode -ne 0) {
+    exit $lastexitcode
+  }
+}
+
+# TODO Add building of examples
+
+# Actual tests (using the test suite)
+Get-ChildItem -Filter test/*.carp | ForEach-Object -Process {
+  exitOnError {
+    echo $_.FullName
+    stack exec carp "--" -x --log-memory $_.FullName
+    echo ""
+  }
+}
+
+# TODO Add tests for error messages
+
+# Just make sure these compile
+exitOnError { stack exec carp "--" ./examples/mutual_recursion.carp -b }
+exitOnError { stack exec carp "--" ./examples/guessing.carp -b }
+exitOnError { stack exec carp "--" ./examples/no_core.carp --no-core -b }
+exitOnError { stack exec carp "--" ./examples/check_malloc.carp -b }
+
+# Generate docs
+exitOnError { stack exec carp "--" ./docs/core/generate_core_docs.carp }
+
+echo "ALL TESTS DONE."
+

src/ArrayTemplates.hs

@@ -325,7 +325,7 @@ templateDeleteArray = defineTypeParameterizedTemplate templateCreator path t doc
                 depsForDeleteFunc typeEnv env insideType)
 
 deleteTy :: TypeEnv -> Env -> Ty -> [Token]
-deleteTy typeEnv env (StructTy "Array" [innerType]) =
+deleteTy typeEnv env (StructTy _ [innerType]) =
   [ TokC   "    for(int i = 0; i < a.len; i++) {\n"
   , TokC $ "    " ++ insideArrayDeletion typeEnv env innerType "i"
   , TokC   "    }\n"
@@ -334,7 +334,7 @@ deleteTy typeEnv env (StructTy "Array" [innerType]) =
 deleteTy _ _ _ = []
 
 initTy :: Ty -> [String]
-initTy (StructTy "Array" [innerType@(FuncTy _ _ _)]) =
+initTy (StructTy "Array" [innerType@FuncTy{}]) =
   [ "    // initialize each Lambda struct "
   , "    for(int i = 0; i < a.len; i++) {"
   , "    " ++ insideArrayInitLambda innerType "i"
@@ -431,7 +431,7 @@ templateStrArray = defineTypeParameterizedTemplate templateCreator path t docs
 
 -- | TODO: move this into the templateStrArray function?
 strTy :: TypeEnv -> Env -> Ty -> [Token]
-strTy typeEnv env (StructTy "Array" [innerType]) =
+strTy typeEnv env (StructTy _ [innerType]) =
   [ TokC   ""
   , TokC   "  String temp = NULL;\n"
   , TokC $ calculateStrSize typeEnv env innerType

src/AssignTypes.hs

@@ -18,6 +18,7 @@ assignTypes mappings root = visit root
       case obj xobj of
         (Lst _) -> visitList xobj
         (Arr _) -> visitArray xobj
+        (StaticArr _) -> visitStaticArray xobj
         _ -> assignType xobj
 
     visitList :: XObj -> Either TypeError XObj
@@ -34,6 +35,13 @@ assignTypes mappings root = visit root
          assignType xobj'
     visitArray _ = error "The function 'visitArray' only accepts XObjs with arrays in them."
 
+    visitStaticArray :: XObj -> Either TypeError XObj
+    visitStaticArray (XObj (StaticArr xobjs) i t) =
+      do visited <- mapM (assignTypes mappings) xobjs
+         let xobj' = XObj (StaticArr visited) i t
+         assignType xobj'
+    visitStaticArray _ = error "The function 'visitStaticArray' only accepts XObjs with arrays in them."
+
     assignType :: XObj -> Either TypeError XObj
     assignType xobj = case ty xobj of
       Just startingType ->

src/Concretize.hs

@@ -50,6 +50,11 @@ concretizeXObj allowAmbiguityRoot typeEnv rootEnv visitedDefinitions root =
          concretizeTypeOfXObj typeEnv xobj
          return $ do okVisited <- visited
                      Right (XObj (Arr okVisited) i (Just t))
+    visit allowAmbig level env xobj@(XObj (StaticArr arr) i (Just t)) =
+      do visited <- fmap sequence (mapM (visit allowAmbig level env) arr)
+         concretizeTypeOfXObj typeEnv xobj
+         return $ do okVisited <- visited
+                     Right (XObj (StaticArr okVisited) i (Just t))
     visit _ _ _ x = return (Right x)
 
     visitList :: Bool -> Level -> Env -> XObj -> State [XObj] (Either TypeError [XObj])
@@ -83,7 +88,7 @@ concretizeXObj allowAmbiguityRoot typeEnv rootEnv visitedDefinitions root =
       return (Left (DefinitionsMustBeAtToplevel xobj))
 
     -- | Fn / λ
-    visitList allowAmbig _ env (XObj (Lst [XObj (Fn _ _ _) fni fnt, args@(XObj (Arr argsArr) ai at), body]) i t) =
+    visitList allowAmbig _ env (XObj (Lst [XObj (Fn _ _) fni fnt, args@(XObj (Arr argsArr) ai at), body]) i t) =
       -- The basic idea of this function is to first visit the body of the lambda ("in place"),
       -- then take the resulting body and put into a separate function 'defn' with a new name
       -- in the global scope. That function definition will be set as the lambdas '.callback' in
@@ -158,7 +163,7 @@ concretizeXObj allowAmbiguityRoot typeEnv rootEnv visitedDefinitions root =
                                  modify (deleterDeps ++)
                                  modify (copyFn :)
                                  modify (copyDeps ++)
-                       return (Right [XObj (Fn (Just lambdaPath) (Set.fromList capturedVars) (FEnv env)) fni fnt, args, okBody])
+                       return (Right [XObj (Fn (Just lambdaPath) (Set.fromList capturedVars)) fni fnt, args, okBody])
            Left err ->
              return (Left err)
 
@@ -314,9 +319,10 @@ collectCapturedVars root = removeDuplicates (map toGeneralSymbol (visit root))
     visit xobj =
       case obj xobj of
         -- don't peek inside lambdas, trust their capture lists:
-        (Lst [XObj (Fn _ captures _ ) _ _, _, _]) -> Set.toList captures
+        (Lst [XObj (Fn _ captures) _ _, _, _]) -> Set.toList captures
         (Lst _) -> visitList xobj
         (Arr _) -> visitArray xobj
+        -- TODO: Static Arrays!
         (Sym path (LookupLocal Capture)) -> [xobj]
         _ -> []
 
@@ -350,7 +356,7 @@ concretizeTypeOfXObj _ xobj = return (Right ())
 
 -- | Find all the concrete deps of a type.
 concretizeType :: TypeEnv -> Ty -> Either TypeError [XObj]
-concretizeType _ ft@(FuncTy _ _ _) =
+concretizeType _ ft@FuncTy{} =
   if isTypeGeneric ft
   then Right []
   else Right [defineFunctionTypeAlias ft]
@@ -359,6 +365,12 @@ concretizeType typeEnv arrayTy@(StructTy "Array" varTys) =
   then Right []
   else do deps <- mapM (concretizeType typeEnv) varTys
           Right (defineArrayTypeAlias arrayTy : concat deps)
+-- TODO: Remove ugly duplication of code here:
+concretizeType typeEnv arrayTy@(StructTy "StaticArray" varTys) =
+  if isTypeGeneric arrayTy
+  then Right []
+  else do deps <- mapM (concretizeType typeEnv) varTys
+          Right (defineStaticArrayTypeAlias arrayTy : concat deps)
 concretizeType typeEnv genericStructTy@(StructTy name _) =
   case lookupInEnv (SymPath [] name) (getTypeEnv typeEnv) of
     Just (_, Binder _ (XObj (Lst (XObj (Deftype originalStructTy) _ _ : _ : rest)) _ _)) ->
@@ -644,7 +656,7 @@ prettyLifetimeMappings mappings =
 -- | the code emitter can access them and insert calls to destructors.
 manageMemory :: TypeEnv -> Env -> XObj -> Either TypeError (XObj, [XObj])
 manageMemory typeEnv globalEnv root =
-  let (finalObj, finalState) = runState (visit root) (MemState (Set.fromList []) [] (Map.empty))
+  let (finalObj, finalState) = runState (visit root) (MemState (Set.fromList []) [] Map.empty)
       deleteThese = memStateDeleters finalState
       deps = memStateDeps finalState
   in  -- (trace ("Delete these: " ++ joinWithComma (map show (Set.toList deleteThese)))) $
@@ -656,13 +668,14 @@ manageMemory typeEnv globalEnv root =
   where visit :: XObj -> State MemState (Either TypeError XObj)
         visit xobj =
           do r <- case obj xobj of
-                    Lst _ -> do visitList xobj
+                    Lst _ -> {-do-} visitList xobj
                                 -- res <- visitList xobj
                                 -- case res of
                                 --   Right ok -> do addToLifetimesMappingsIfRef True ok
                                 --                  return res
                                 --   Left err -> return (Left err)
                     Arr _ -> visitArray xobj
+                    StaticArr _ -> visitStaticArray xobj
                     Str _ -> do manage xobj
                                 addToLifetimesMappingsIfRef False xobj -- TODO: Should "internal = True" here?
                                 return (Right xobj)
@@ -673,7 +686,7 @@ manageMemory typeEnv globalEnv root =
                       return (Right xobj)
              case r of
                Right ok -> do MemState _ _ m <- get
-                              checkThatRefTargetIsAlive $ --trace ("CHECKING " ++ pretty ok ++ " : " ++ showMaybeTy (ty xobj) ++ ", mappings: " ++ prettyLifetimeMappings m) $
+                              checkThatRefTargetIsAlive --trace ("CHECKING " ++ pretty ok ++ " : " ++ showMaybeTy (ty xobj) ++ ", mappings: " ++ prettyLifetimeMappings m) $
                                 ok
                Left err -> return (Left err)
 
@@ -689,16 +702,40 @@ manageMemory typeEnv globalEnv root =
 
         visitArray _ = error "Must visit array."
 
+        visitStaticArray :: XObj -> State MemState (Either TypeError XObj)
+        visitStaticArray xobj@(XObj (StaticArr arr) _ _) =
+          do mapM_ visit arr
+             results <- mapM unmanage arr
+             case sequence results of
+               Left e -> return (Left e)
+               Right _ ->
+                 -- We know that we want to add a deleter for the static array here
+                 do let var = varOfXObj xobj
+                        Just (RefTy t@(StructTy "StaticArray" [_]) _) = ty xobj
+                        deleter = case nameOfPolymorphicFunction typeEnv globalEnv (FuncTy [t] UnitTy StaticLifetimeTy) "delete" of
+                                    Just pathOfDeleteFunc ->
+                                      ProperDeleter pathOfDeleteFunc var
+                                    Nothing ->
+                                      error ("No deleter found for Static Array : " ++ show t) --Just (FakeDeleter var)
+                    MemState deleters deps lifetimes <- get
+                    let newDeleters = Set.insert deleter deleters
+                        newDeps = deps ++ depsForDeleteFunc typeEnv globalEnv t
+                        newState = (MemState newDeleters newDeps lifetimes)
+                    put newState --(trace (show newState) newState)
+                    return (Right xobj)
+
+        visitStaticArray _ = error "Must visit static array."
+
         visitList :: XObj -> State MemState (Either TypeError XObj)
         visitList xobj@(XObj (Lst lst) i t) =
           case lst of
             [defn@(XObj (Defn maybeCaptures) _ _), nameSymbol@(XObj (Sym _ _) _ _), args@(XObj (Arr argList) _ _), body] ->
               let Just funcTy@(FuncTy _ defnReturnType _) = t
                   captures = fromMaybe [] (fmap Set.toList maybeCaptures)
-              in case defnReturnType of
+              in --case defnReturnType of
                    -- RefTy _ _ ->
                    --   return (Left (FunctionsCantReturnRefTy xobj funcTy))
-                   _ ->
+                 --  _ ->
                      do mapM_ manage argList
                         -- Add the captured variables (if any, only happens in lifted lambdas) as fake deleters
                         -- TODO: Use another kind of Deleter for this case since it's pretty special?
@@ -719,7 +756,7 @@ manageMemory typeEnv globalEnv root =
                                  return (XObj (Lst [defn, nameSymbol, args, okBody]) i t)
 
             -- Fn / λ (Lambda)
-            [fn@(XObj (Fn _ captures _) _ _), args@(XObj (Arr argList) _ _), body] ->
+            [fn@(XObj (Fn _ captures) _ _), args@(XObj (Arr argList) _ _), body] ->
               let Just funcTy@(FuncTy _ fnReturnType _) = t
               in  do manage xobj -- manage inner lambdas but leave their bodies unvisited, they will be visited in the lifted version...
                      mapM_ unmanage captures
@@ -739,10 +776,10 @@ manageMemory typeEnv globalEnv root =
             -- Let
             [letExpr@(XObj Let _ _), XObj (Arr bindings) bindi bindt, body] ->
               let Just letReturnType = t
-              in case letReturnType of
+              in --case letReturnType of
                 -- RefTy _ _ ->
                 --   return (Left (LetCantReturnRefTy xobj letReturnType))
-                _ ->
+               -- _ ->
                   do MemState preDeleters _ _ <- get
                      visitedBindings <- mapM visitLetBinding (pairwise bindings)
                      visitedBody <- visit  body
@@ -1067,7 +1104,7 @@ manageMemory typeEnv globalEnv root =
                     if internal then
                       LifetimeInsideFunction $
                       case xobj of
-                        XObj (Lst [(XObj Ref _ _), target]) _ _ -> varOfXObj target
+                        XObj (Lst [XObj Ref _ _, target]) _ _ -> varOfXObj target
                         _ -> varOfXObj xobj
                     else
                       LifetimeOutsideFunction
@@ -1106,13 +1143,14 @@ manageMemory typeEnv globalEnv root =
                          --trace ("Lifetime OUTSIDE function: " ++ pretty xobj ++ " at " ++ prettyInfoFromXObj xobj) $
                          return (Right xobj)
                        Nothing ->
-                         case xobj of
+                         return (Right xobj)
+                         --case xobj of
                            -- XObj (Sym _ (LookupLocal Capture)) _ _ ->
                            --   -- Ignore these for the moment! TODO: FIX!!!
                            --   return (Right xobj)
-                           _ ->
+                           --_ ->
                              --trace ("Failed to find lifetime key (when checking) '" ++ lt ++ "' for " ++ pretty xobj ++ " in mappings at " ++ prettyInfoFromXObj xobj) $
-                             return (Right xobj)
+                             --return (Right xobj)
 
         visitLetBinding :: (XObj, XObj) -> State MemState (Either TypeError (XObj, XObj))
         visitLetBinding  (name, expr) =
@@ -1126,11 +1164,7 @@ manageMemory typeEnv globalEnv root =
 
         visitArg :: XObj -> State MemState (Either TypeError XObj)
         visitArg xobj@(XObj _ _ (Just t)) =
-          do afterVisit <- if isManaged typeEnv t
-                           then do visitedXObj <- visit  xobj
-                                   --result <- unmanage xobj
-                                   return visitedXObj
-                           else visit xobj
+          do afterVisit <- visit xobj
              case afterVisit of
                Right okAfterVisit -> do addToLifetimesMappingsIfRef True okAfterVisit
                                         return (Right okAfterVisit)
@@ -1140,12 +1174,12 @@ manageMemory typeEnv globalEnv root =
 
         unmanageArg :: XObj -> State MemState (Either TypeError XObj)
         unmanageArg xobj@(XObj _ _ (Just t)) =
-          do if isManaged typeEnv t
-               then do r <- unmanage xobj
-                       case r of
-                         Left err -> return (Left err)
-                         Right () -> return (Right xobj)
-               else return (Right xobj)
+          if isManaged typeEnv t
+            then do r <- unmanage xobj
+                    case r of
+                      Left err -> return (Left err)
+                      Right () -> return (Right xobj)
+            else return (Right xobj)
         unmanageArg xobj@XObj{} =
           return (Right xobj)
 
@@ -1207,7 +1241,7 @@ manageMemory typeEnv globalEnv root =
                        [one] -> let newDeleters = Set.delete one deleters
                                 in  do put (MemState newDeleters deps lifetimes)
                                        return (Right ())
-                       _ -> error "Too many variables with the same name in set."
+                       tooMany -> error ("Too many variables with the same name in set: " ++ show tooMany)
              else return (Right ())
 
         -- | Check that the value being referenced hasn't already been given away
@@ -1234,13 +1268,13 @@ manageMemory typeEnv globalEnv root =
                Right _ -> do manage to --(trace ("Transfered from " ++ getName from ++ " '" ++ varOfXObj from ++ "' to " ++ getName to ++ " '" ++ varOfXObj to ++ "'") to)
                              return (Right ())
 
-        varOfXObj :: XObj -> String
-        varOfXObj xobj =
-          case xobj of
-            XObj (Sym path _) _ _ -> pathToC path
-            _ -> case info xobj of
-                   Just i -> freshVar i
-                   Nothing -> error ("Missing info on " ++ show xobj)
+varOfXObj :: XObj -> String
+varOfXObj xobj =
+  case xobj of
+    XObj (Sym path _) _ _ -> pathToC path
+    _ -> case info xobj of
+           Just i -> freshVar i
+           Nothing -> error ("Missing info on " ++ show xobj)
 
 suffixTyVars :: String -> Ty -> Ty
 suffixTyVars suffix t =
@@ -1255,10 +1289,10 @@ suffixTyVars suffix 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
+    XObj (InterfaceSym _) _ (Just FuncTy{}) -> True
+    XObj (MultiSym _ _) _ (Just FuncTy{}) -> True
+    XObj (Sym _ (LookupGlobal _ _)) _ (Just FuncTy{}) -> True
+    XObj (Sym _ (LookupGlobalOverride _)) _ (Just FuncTy{}) -> True
     _ -> False
 
 -- | The following functions will generate deleters and copy:ing methods for structs, they are shared with the Deftype module

src/Deftype.hs

@@ -222,7 +222,7 @@ concreteInit allocationMode originalStructTy@(StructTy typeName typeVariables) m
          memberPairs = memberXObjsToPairs correctedMembers
      in  (toTemplate $ "$p $NAME(" ++ joinWithComma (map memberArg memberPairs) ++ ")"))
     (const (tokensForInit allocationMode typeName membersXObjs))
-    (\(FuncTy _ _ _) -> [])
+    (\FuncTy{} -> [])
 
 -- | The template for the 'init' and 'new' functions for a generic deftype.
 genericInit :: AllocationMode -> [String] -> Ty -> [XObj] -> (String, Binder)

src/Emit.hs

@@ -96,6 +96,7 @@ toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent roo
           case obj xobj of
             Lst _   -> visitList indent xobj
             Arr _   -> visitArray indent xobj
+            StaticArr _ -> visitStaticArray indent xobj
             Num IntTy num -> return (show (round num :: Int))
             Num LongTy num -> return (show (round num :: Int) ++ "l")
             Num ByteTy num -> return (show (round num :: Int))
@@ -110,6 +111,7 @@ toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent roo
                                 '\n' -> "'\\n'"
                                 '\\' -> "'\\\\'"
                                 x -> ['\'', x, '\'']
+            Closure elem _ -> visit indent elem
             Sym _ _ -> visitSymbol indent xobj
             (Defn _) -> error (show (DontVisitObj xobj))
             Def -> error (show (DontVisitObj xobj))
@@ -200,7 +202,7 @@ toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent roo
                      return ""
 
             -- Fn / λ
-            [XObj (Fn name set _) _ _, XObj (Arr argList) _ _, body] ->
+            [XObj (Fn name set) _ _, XObj (Arr argList) _ _, body] ->
               do let retVar = freshVar i
                      capturedVars = Set.toList set
                      Just callback = name
@@ -584,7 +586,6 @@ toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent roo
                           " .data = CARP_MALLOC(sizeof(" ++ tyToCLambdaFix innerTy ++ ") * " ++ show len ++ ") };\n")
              zipWithM_ (visitArrayElement indent arrayVar innerTy) [0..] xobjs
              return arrayVar
-
         visitArray _ _ = error "Must visit array!"
 
         visitArrayElement :: Int -> String -> Ty -> Int -> XObj -> State EmitterState ()
@@ -594,6 +595,29 @@ toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent roo
                           ".data)[" ++ show index ++ "] = " ++ visited ++ ";\n")
              return ()
 
+        visitStaticArray :: Int -> XObj -> State EmitterState String
+        visitStaticArray indent (XObj (StaticArr xobjs) (Just i) t) =
+          do let arrayVar = freshVar i
+                 retVar = arrayVar ++ "_retref"
+                 arrayDataVar = arrayVar ++ "_data"
+                 len = length xobjs
+                 Just tt@(RefTy (StructTy "StaticArray" [innerTy]) _) = t
+             appendToSrc (addIndent indent ++ tyToCLambdaFix innerTy ++ " " ++ arrayDataVar ++ "[" ++ show len ++ "];\n")
+             appendToSrc (addIndent indent ++ "Array " ++ arrayVar ++
+                           " = { .len = " ++ show len ++ "," ++
+                          " /* .capacity = DOES NOT MATTER, STACK ALLOCATED ARRAY, */" ++
+                          " .data = " ++ arrayDataVar ++ " };\n")
+             zipWithM_ (visitStaticArrayElement indent arrayDataVar innerTy) [0..] xobjs
+             appendToSrc (addIndent indent ++ tyToCLambdaFix tt ++ " " ++ retVar ++ " = &" ++ arrayVar ++ ";\n")
+             return retVar
+        visitStaticArray _ _ = error "Must visit static array!"
+
+        visitStaticArrayElement :: Int -> String -> Ty -> Int -> XObj -> State EmitterState ()
+        visitStaticArrayElement indent arrayDataVar innerTy index xobj =
+          do visited <- visit indent xobj
+             appendToSrc (addIndent indent ++ arrayDataVar ++ "[" ++ show index ++ "] = " ++ visited ++ ";\n")
+             return ()
+
 delete :: Int -> Info -> State EmitterState ()
 delete indent i = mapM_ deleterToC (infoDelete i)
   where deleterToC :: Deleter -> State EmitterState ()
@@ -827,6 +851,7 @@ checkForUnresolvedSymbols = visit
           case obj xobj of
             (Lst _) -> visitList xobj
             (Arr _) -> visitArray xobj
+            (StaticArr _) -> visitStaticArray xobj
             (MultiSym _ _) -> Left (UnresolvedMultiSymbol xobj)
             (InterfaceSym _) -> Left (UnresolvedInterfaceSymbol xobj)
             _ -> return ()
@@ -845,6 +870,13 @@ checkForUnresolvedSymbols = visit
         Right _ -> return ()
     visitArray _ = error "The function 'visitArray' only accepts XObjs with arrays in them."
 
+    visitStaticArray :: XObj -> Either ToCError ()
+    visitStaticArray (XObj (StaticArr xobjs) i t) =
+      case mapM visit xobjs of
+        Left e -> Left e
+        Right _ -> return ()
+    visitStaticArray _ = error "The function 'visitStaticArray' only accepts XObjs with arrays in them."
+
 wrapInInitFunction :: Bool -> String -> String
 wrapInInitFunction with_core src =
   "void carp_init_globals(int argc, char** argv) {\n" ++

src/Expand.hs

@@ -1,7 +1,7 @@
 module Expand (expandAll, replaceSourceInfoOnXObj) where
 
-import Control.Monad.State.Lazy (StateT(..), runStateT, liftIO, modify, get, put)
-import Control.Monad.State
+import Control.Monad.State (evalState, get, put, State)
+import Data.Foldable (foldlM)
 import Debug.Trace
 
 import Types
@@ -11,171 +11,185 @@ import Lookup
 import TypeError
 
 -- | Used for calling back to the 'eval' function in Eval.hs
-type DynamicEvaluator = Env -> XObj -> StateT Context IO (Either EvalError XObj)
+type DynamicEvaluator = Context -> XObj -> IO (Context, Either EvalError XObj)
 
 -- | Keep expanding the form until it doesn't change anymore.
 -- | Note: comparing environments is tricky! Make sure they *can* be equal, otherwise this won't work at all!
-expandAll :: DynamicEvaluator -> Env -> XObj -> StateT Context IO (Either EvalError XObj)
-expandAll eval env root =
-  do fullyExpanded <- expandAllInternal root
-     return (fmap setNewIdentifiers fullyExpanded)
+expandAll :: DynamicEvaluator -> Context -> XObj -> IO (Context, Either EvalError XObj)
+expandAll eval ctx root =
+  do (ctx, fullyExpanded) <- expandAllInternal root
+     return (ctx, fmap setNewIdentifiers fullyExpanded)
   where expandAllInternal xobj =
-          do expansionResult <- expand eval env xobj
+          do (newCtx, expansionResult) <- expand eval ctx xobj
              case expansionResult of
                Right expanded -> if expanded == xobj
-                                 then return (Right expanded)
-                                 else expandAll eval env expanded
-               err -> return err
+                                 then return (ctx, Right expanded)
+                                 else expandAll eval newCtx expanded
+               err -> return (newCtx, err)
 
 -- | Macro expansion of a single form
-expand :: DynamicEvaluator -> Env -> XObj -> StateT Context IO (Either EvalError XObj)
-expand eval env xobj =
+expand :: DynamicEvaluator -> Context -> XObj -> IO (Context, Either EvalError XObj)
+expand eval ctx xobj =
   case obj xobj of
   --case obj (trace ("Expand: " ++ pretty xobj) xobj) of
     Lst _ -> expandList xobj
     Arr _ -> expandArray xobj
-    Sym _ _ -> expandSymbol xobj
-    _     -> return (Right xobj)
+    Sym _ _ -> return (ctx, expandSymbol xobj)
+    _     -> return (ctx, Right xobj)
 
   where
-    expandList :: XObj -> StateT Context IO (Either EvalError XObj)
+    expandList :: XObj -> IO (Context, Either EvalError XObj)
     expandList (XObj (Lst xobjs) i t) = do
-      ctx <- get
       let fppl = projectFilePathPrintLength (contextProj ctx)
       case xobjs of
-        [] -> return (Right xobj)
-        XObj (External _) _ _ : _ -> return (Right xobj)
-        XObj (Instantiate _) _ _ : _ -> return (Right xobj)
-        XObj (Deftemplate _) _ _ : _ -> return (Right xobj)
-        XObj (Defalias _) _ _ : _ -> return (Right xobj)
+        [] -> return (ctx, Right xobj)
+        XObj (External _) _ _ : _ -> return (ctx, Right xobj)
+        XObj (Instantiate _) _ _ : _ -> return (ctx, Right xobj)
+        XObj (Deftemplate _) _ _ : _ -> return (ctx, Right xobj)
+        XObj (Defalias _) _ _ : _ -> return (ctx, Right xobj)
         [defnExpr@(XObj (Defn _) _ _), name, args, body] ->
-          do expandedBody <- expand eval env body
-             return $ do okBody <- expandedBody
-                         Right (XObj (Lst [defnExpr, name, args, okBody]) i t)
+          do (ctx, expandedBody) <- expand eval ctx body
+             return (ctx, do okBody <- expandedBody
+                             Right (XObj (Lst [defnExpr, name, args, okBody]) i t))
         [defExpr@(XObj Def _ _), name, expr] ->
-          do expandedExpr <- expand eval env expr
-             return $ do okExpr <- expandedExpr
-                         Right (XObj (Lst [defExpr, name, okExpr]) i t)
+          do (ctx, expandedExpr) <- expand eval ctx expr
+             return (ctx, do okExpr <- expandedExpr
+                             Right (XObj (Lst [defExpr, name, okExpr]) i t))
         [theExpr@(XObj The _ _), typeXObj, value] ->
-          do expandedValue <- expand eval env value
-             return $ do okValue <- expandedValue
-                         Right (XObj (Lst [theExpr, typeXObj, okValue]) i t)
+          do (ctx, expandedValue) <- expand eval ctx value
+             return (ctx, do okValue <- expandedValue
+                             Right (XObj (Lst [theExpr, typeXObj, okValue]) i t))
         (XObj The _ _ : _) ->
-            return (makeEvalError ctx Nothing ("I didn’t understand the `the` at " ++ prettyInfoFromXObj xobj ++ ":\n\n" ++ pretty xobj ++ "\n\nIs it valid? Every `the` needs to follow the form `(the type expression)`.") Nothing)
+            return (evalError ctx ("I didn’t understand the `the` at " ++ prettyInfoFromXObj xobj ++ ":\n\n" ++ pretty xobj ++ "\n\nIs it valid? Every `the` needs to follow the form `(the type expression)`.") Nothing)
         [ifExpr@(XObj If _ _), condition, trueBranch, falseBranch] ->
-          do expandedCondition <- expand eval env condition
-             expandedTrueBranch <- expand eval env trueBranch
-             expandedFalseBranch <- expand eval env falseBranch
-             return $ do okCondition <- expandedCondition
-                         okTrueBranch <- expandedTrueBranch
-                         okFalseBranch <- expandedFalseBranch
-                         -- This is a HACK so that each branch of the if statement
-                         -- has a "safe place" (= a do-expression with just one element)
-                         -- where it can store info about its deleters. Without this,
-                         -- An if statement with let-expression inside will duplicate
-                         -- the calls to Delete when emitting code.
-                         let wrappedTrue =
-                               case okTrueBranch of
-                                 XObj (Lst (XObj Do _ _ : _)) _ _ -> okTrueBranch -- Has a do-expression already
-                                 _ -> XObj (Lst [XObj Do Nothing Nothing, okTrueBranch]) (info okTrueBranch) Nothing
-                             wrappedFalse =
-                               case okFalseBranch of
-                                 XObj (Lst (XObj Do _ _ : _)) _ _ -> okFalseBranch -- Has a do-expression already
-                                 _ -> XObj (Lst [XObj Do Nothing Nothing, okFalseBranch]) (info okFalseBranch) Nothing
+          do (ctx, expandedCondition) <- expand eval ctx condition
+             (ctx, expandedTrueBranch) <- expand eval ctx trueBranch
+             (ctx, expandedFalseBranch) <- expand eval ctx falseBranch
+             return (ctx, do okCondition <- expandedCondition
+                             okTrueBranch <- expandedTrueBranch
+                             okFalseBranch <- expandedFalseBranch
+                             -- This is a HACK so that each branch of the if statement
+                             -- has a "safe place" (= a do-expression with just one element)
+                             -- where it can store info about its deleters. Without this,
+                             -- An if statement with let-expression inside will duplicate
+                             -- the calls to Delete when emitting code.
+                             let wrappedTrue =
+                                   case okTrueBranch of
+                                     XObj (Lst (XObj Do _ _ : _)) _ _ -> okTrueBranch -- Has a do-expression already
+                                     _ -> XObj (Lst [XObj Do Nothing Nothing, okTrueBranch]) (info okTrueBranch) Nothing
+                                 wrappedFalse =
+                                   case okFalseBranch of
+                                     XObj (Lst (XObj Do _ _ : _)) _ _ -> okFalseBranch -- Has a do-expression already
+                                     _ -> XObj (Lst [XObj Do Nothing Nothing, okFalseBranch]) (info okFalseBranch) Nothing
 
-                         Right (XObj (Lst [ifExpr, okCondition, wrappedTrue, wrappedFalse]) i t)
+                             Right (XObj (Lst [ifExpr, okCondition, wrappedTrue, wrappedFalse]) i t))
         [letExpr@(XObj Let _ _), XObj (Arr bindings) bindi bindt, body] ->
           if even (length bindings)
-          then do bind <- mapM (\(n, x) -> do x' <- expand eval env x
-                                              return $ do okX <- x'
-                                                          Right [n, okX])
-                               (pairwise bindings)
-                  expandedBody <- expand eval env body
-                  return $ do okBindings <- sequence bind
-                              okBody <- expandedBody
-                              Right (XObj (Lst [letExpr, XObj (Arr (concat okBindings)) bindi bindt, okBody]) i t)
-          else return (makeEvalError ctx Nothing (
+          then do (ctx, bind) <- foldlM successiveExpand (ctx, Right []) (pairwise bindings)
+                  (newCtx, expandedBody) <- expand eval ctx body
+                  return (newCtx, do okBindings <- bind
+                                     okBody <- expandedBody
+                                     Right (XObj (Lst [letExpr, XObj (Arr (concat okBindings)) bindi bindt, okBody]) i t))
+          else return (evalError ctx (
             "I ecountered an odd number of forms inside a `let` (`" ++
-            pretty xobj ++ "`)")
-            (info xobj))
+            pretty xobj ++ "`)") (info xobj))
+          where successiveExpand (ctx, acc) (n, x) =
+                  case acc of
+                    Left err -> return (ctx, acc)
+                    Right l -> do
+                      (newCtx, x') <- expand eval ctx x
+                      case x' of
+                        Left err -> return (newCtx, Left err)
+                        Right okX -> return (newCtx, Right (l ++ [[n, okX]]))
 
         matchExpr@(XObj Match _ _) : (expr : rest)
           | null rest ->
-              return (makeEvalError ctx Nothing "I encountered a `match` without forms" (info xobj))
+              return (evalError ctx "I encountered a `match` without forms" (info xobj))
           | even (length rest) ->
-              do expandedExpr <- expand eval env expr
-                 expandedPairs <- mapM (\(l,r) -> do expandedR <- expand eval env r
-                                                     return [Right l, expandedR])
-                                       (pairwise rest)
-                 let expandedRest = sequence (concat expandedPairs)
-                 return $ do okExpandedExpr <- expandedExpr
-                             okExpandedRest <- expandedRest
-                             return (XObj (Lst (matchExpr : okExpandedExpr : okExpandedRest)) i t)
-          | otherwise -> return (makeEvalError ctx Nothing
-                    "I encountered an odd number of forms inside a `match`"
-                    (info xobj))
+              do (ctx, expandedExpr) <- expand eval ctx expr
+                 (newCtx, expandedPairs) <- foldlM successiveExpand (ctx, Right []) (pairwise rest)
+                 return (newCtx, do okExpandedExpr <- expandedExpr
+                                    okExpandedPairs <- expandedPairs
+                                    Right (XObj (Lst (matchExpr : okExpandedExpr : (concat okExpandedPairs))) i t))
+          | otherwise -> return (evalError ctx
+                    "I encountered an odd number of forms inside a `match`" (info xobj))
+          where successiveExpand (ctx, acc) (l, r) =
+                  case acc of
+                    Left err -> return (ctx, acc)
+                    Right lst -> do
+                      (newCtx, expandedR) <- expand eval ctx r
+                      case expandedR of
+                        Left err -> return (newCtx, Left err)
+                        Right v -> return (newCtx, Right (lst ++ [[l, v]]))
 
         doExpr@(XObj Do _ _) : expressions ->
-          do expandedExpressions <- mapM (expand eval env) expressions
-             return $ do okExpressions <- sequence expandedExpressions
-                         Right (XObj (Lst (doExpr : okExpressions)) i t)
+          do (newCtx, expandedExpressions) <- foldlM successiveExpand (ctx, Right []) expressions
+             return (newCtx, do okExpressions <- expandedExpressions
+                                Right (XObj (Lst (doExpr : okExpressions)) i t))
         [withExpr@(XObj With _ _), pathExpr@(XObj (Sym path _) _ _), expression] ->
-          do expandedExpression <- expand eval env expression
-             return $ do okExpression <- expandedExpression
-                         Right (XObj (Lst [withExpr, pathExpr , okExpression]) i t) -- Replace the with-expression with just the expression!
+          do (newCtx, expandedExpression) <- expand eval ctx expression
+             return (newCtx, do okExpression <- expandedExpression
+                                Right (XObj (Lst [withExpr, pathExpr , okExpression]) i t)) -- Replace the with-expression with just the expression!
         [withExpr@(XObj With _ _), _, _] ->
-          return (makeEvalError ctx Nothing ("I encountered the value `" ++ pretty xobj ++
+          return (evalError ctx ("I encountered the value `" ++ pretty xobj ++
             "` inside a `with` at " ++ prettyInfoFromXObj xobj ++
-            ".\n\n`with` accepts only symbols.")
-            Nothing)
+            ".\n\n`with` accepts only symbols.") Nothing)
         XObj With _ _ : _ ->
-          return (makeEvalError ctx Nothing (
+          return (evalError ctx (
             "I encountered multiple forms inside a `with` at " ++
             prettyInfoFromXObj xobj ++
-            ".\n\n`with` accepts only one expression, except at the top level.")
-            Nothing)
+            ".\n\n`with` accepts only one expression, except at the top level.") Nothing)
         XObj Mod{} _ _ : _ ->
-          return (makeEvalError ctx Nothing ("I can’t evaluate the module `" ++
-                                             pretty xobj ++ "`")
-                                            (info xobj))
-        f:args -> do expandedF <- expand eval env f
-                     expandedArgs <- fmap sequence (mapM (expand eval env) args)
-                     case expandedF of
-                       Right (XObj (Lst [XObj Dynamic _ _, _, XObj (Arr _) _ _, _]) _ _) ->
-                         --trace ("Found dynamic: " ++ pretty xobj)
-                         eval env xobj
-                       Right (XObj (Lst [XObj Macro _ _, _, XObj (Arr _) _ _, _]) _ _) ->
-                         --trace ("Found macro: " ++ pretty xobj ++ " at " ++ prettyInfoFromXObj xobj)
-                         eval env xobj
-                       Right (XObj (Lst [XObj (Command callback) _ _, _]) _ _) ->
-                         getCommand callback args
-                       Right _ ->
-                         return $ do okF <- expandedF
-                                     okArgs <- expandedArgs
-                                     Right (XObj (Lst (okF : okArgs)) i t)
-                       Left err -> return (Left err)
+          return (evalError ctx ("I can’t evaluate the module `" ++ pretty xobj ++ "`") (info xobj))
+        f:args ->
+          do (ctx', expandedF) <- expand eval ctx f
+             (ctx'', expandedArgs) <- foldlM successiveExpand (ctx, Right []) args
+             case expandedF of
+               Right (XObj (Lst [XObj Dynamic _ _, _, XObj (Arr _) _ _, _]) _ _) ->
+                 --trace ("Found dynamic: " ++ pretty xobj)
+                 eval ctx'' xobj
+               Right (XObj (Lst [XObj Macro _ _, _, XObj (Arr _) _ _, _]) _ _) ->
+                 --trace ("Found macro: " ++ pretty xobj ++ " at " ++ prettyInfoFromXObj xobj)
+                 eval ctx'' xobj
+               Right (XObj (Lst [XObj (Command callback) _ _, _]) _ _) ->
+                 getCommand callback ctx args
+               Right _ ->
+                 return (ctx'', do okF <- expandedF
+                                   okArgs <- expandedArgs
+                                   Right (XObj (Lst (okF : okArgs)) i t))
+               Left err -> return (ctx'', Left err)
     expandList _ = error "Can't expand non-list in expandList."
 
-    expandArray :: XObj -> StateT Context IO (Either EvalError XObj)
+    expandArray :: XObj -> IO (Context, Either EvalError XObj)
     expandArray (XObj (Arr xobjs) i t) =
-      do evaledXObjs <- fmap sequence (mapM (expand eval env) xobjs)
-         return $ do okXObjs <- evaledXObjs
-                     Right (XObj (Arr okXObjs) i t)
+      do (newCtx, evaledXObjs) <- foldlM successiveExpand (ctx, Right []) xobjs
+         return (newCtx, do okXObjs <- evaledXObjs
+                            Right (XObj (Arr okXObjs) i t))
     expandArray _ = error "Can't expand non-array in expandArray."
 
-    expandSymbol :: XObj -> StateT Context IO (Either a XObj)
+    expandSymbol :: XObj -> Either a XObj
     expandSymbol (XObj (Sym path _) _ _) =
-      case lookupInEnv path env of
-        Just (_, Binder _ (XObj (Lst (XObj (External _) _ _ : _)) _ _)) -> return (Right xobj)
-        Just (_, Binder _ (XObj (Lst (XObj (Instantiate _) _ _ : _)) _ _)) -> return (Right xobj)
-        Just (_, Binder _ (XObj (Lst (XObj (Deftemplate _) _ _ : _)) _ _)) -> return (Right xobj)
-        Just (_, Binder _ (XObj (Lst (XObj (Defn _) _ _ : _)) _ _)) -> return (Right xobj)
-        Just (_, Binder _ (XObj (Lst (XObj Def _ _ : _)) _ _)) -> return (Right xobj)
-        Just (_, Binder _ (XObj (Lst (XObj (Defalias _) _ _ : _)) _ _)) -> return (Right xobj)
-        Just (_, Binder _ found) -> return (Right found) -- use the found value
-        Nothing -> return (Right xobj) -- symbols that are not found are left as-is
+      case lookupInEnv path (contextEnv ctx) of
+        Just (_, Binder _ (XObj (Lst (XObj (External _) _ _ : _)) _ _)) -> Right xobj
+        Just (_, Binder _ (XObj (Lst (XObj (Instantiate _) _ _ : _)) _ _)) -> Right xobj
+        Just (_, Binder _ (XObj (Lst (XObj (Deftemplate _) _ _ : _)) _ _)) -> Right xobj
+        Just (_, Binder _ (XObj (Lst (XObj (Defn _) _ _ : _)) _ _)) -> Right xobj
+        Just (_, Binder _ (XObj (Lst (XObj Def _ _ : _)) _ _)) -> Right xobj
+        Just (_, Binder _ (XObj (Lst (XObj (Defalias _) _ _ : _)) _ _)) -> Right xobj
+        Just (_, Binder _ found) -> Right found -- use the found value
+        Nothing -> Right xobj -- symbols that are not found are left as-is
     expandSymbol _ = error "Can't expand non-symbol in expandSymbol."
 
+    successiveExpand (ctx, acc) e =
+      case acc of
+        Left err -> return (ctx, acc)
+        Right lst -> do
+          (newCtx, expanded) <- expand eval ctx e
+          case expanded of
+            Right e -> do
+              return (newCtx, Right (lst ++ [e]))
+            Left err -> return (ctx, Left err)
+
 -- | Replace all the infoIdentifier:s on all nested XObj:s
 setNewIdentifiers :: XObj -> XObj
 setNewIdentifiers root = let final = evalState (visit root) 0
@@ -187,6 +201,7 @@ setNewIdentifiers root = let final = evalState (visit root) 0
       case obj xobj of
         (Lst _) -> visitList xobj
         (Arr _) -> visitArray xobj
+        (StaticArr _) -> visitStaticArray xobj
         _ -> bumpAndSet xobj
 
     visitList :: XObj -> State Int XObj
@@ -203,6 +218,13 @@ setNewIdentifiers root = let final = evalState (visit root) 0
          bumpAndSet xobj'
     visitArray _ = error "The function 'visitArray' only accepts XObjs with arrays in them."
 
+    visitStaticArray :: XObj -> State Int XObj
+    visitStaticArray (XObj (StaticArr xobjs) i t) =
+      do visited <- mapM visit xobjs
+         let xobj' = XObj (StaticArr visited) i t
+         bumpAndSet xobj'
+    visitStaticArray _ = error "The function 'visitStaticArray' only accepts XObjs with arrays in them."
+
     bumpAndSet :: XObj -> State Int XObj
     bumpAndSet xobj =
       do counter <- get

src/GenerateConstraints.hs

@@ -52,7 +52,7 @@ genConstraints globalEnv root rootSig = fmap sort (gen root)
                              genF xobj args body (fromMaybe Set.empty captures)
 
                            -- Fn
-                           [XObj (Fn _ captures _) _ _, XObj (Arr args) _ _, body] ->
+                           [XObj (Fn _ captures) _ _, XObj (Arr args) _ _, body] ->
                              genF xobj args body captures
 
                            -- Def
@@ -195,7 +195,7 @@ genConstraints globalEnv root rootSig = fmap sort (gen root)
                              do insideValueConstraints <- gen value
                                 xobjType <- toEither (ty xobj) (ExpressionMissingType xobj)
                                 valueType <- toEither (ty value) (ExpressionMissingType value)
-                                let lt = (VarTy (makeTypeVariableNameFromInfo (info xobj)))
+                                let lt = VarTy (makeTypeVariableNameFromInfo (info xobj))
                                 let theTheConstraint = Constraint (RefTy xobjType lt) valueType xobj value xobj OrdDeref
                                 return (theTheConstraint : insideValueConstraints)
 
@@ -248,4 +248,19 @@ genConstraints globalEnv root rootSig = fmap sort (gen root)
                                headConstraint = Constraint headTy t headObj (genObj x 1) xobj OrdArrHead
                            return (headConstraint : insideExprConstraints ++ betweenExprConstraints)
 
+            -- THIS CODE IS VERY MUCH A DUPLICATION OF THE 'ARR' CODE FROM ABOVE:
+            (StaticArr arr) ->
+              case arr of
+                [] -> Right []
+                x:xs -> do insideExprConstraints <- fmap join (mapM gen arr)
+                           let Just headTy = ty x
+                               genObj o n = XObj (Sym (SymPath [] ("Whereas the " ++ enumerate n ++ " element in the array is " ++ show (getPath o))) Symbol)
+                                  (info o) (ty o)
+                               headObj = XObj (Sym (SymPath [] ("I inferred the type of the static array from its first element " ++ show (getPath x))) Symbol)
+                                  (info x) (Just headTy)
+                               Just (RefTy(StructTy "StaticArray" [t]) _) = ty xobj
+                               betweenExprConstraints = zipWith (\o n -> Constraint headTy (forceTy o) headObj (genObj o n) xobj OrdArrBetween) xs [1..]
+                               headConstraint = Constraint headTy t headObj (genObj x 1) xobj OrdArrHead
+                           return (headConstraint : insideExprConstraints ++ betweenExprConstraints)
+
             _ -> Right []

src/InitialTypes.hs

@@ -77,13 +77,14 @@ initialTypes typeEnv rootEnv root = evalState (visit rootEnv root) 0
                        (Command _)        -> return (Right (xobj { ty = Just DynamicTy }))
                        (Lst _)            -> visitList env xobj
                        (Arr _)            -> visitArray env xobj
+                       (StaticArr _)      -> visitStaticArray env xobj
                        (Dict _)           -> visitDictionary env xobj
                        (Sym symPath _)    -> visitSymbol env xobj symPath
                        (MultiSym _ paths) -> visitMultiSym env xobj paths
                        (InterfaceSym _)   -> visitInterfaceSym env xobj
                        e@(Defn _)         -> return (Left (InvalidObj e xobj))
                        Def                -> return (Left (InvalidObj Def xobj))
-                       e@(Fn _ _ _)       -> return (Left (InvalidObj e xobj))
+                       e@(Fn _ _)         -> return (Left (InvalidObj e xobj))
                        Let                -> return (Left (InvalidObj Let xobj))
                        If                 -> return (Left (InvalidObj If xobj))
                        While              -> return (Left (InvalidObj While xobj))
@@ -147,6 +148,16 @@ initialTypes typeEnv rootEnv root = evalState (visit rootEnv root) 0
 
     visitArray _ _ = error "The function 'visitArray' only accepts XObj:s with arrays in them."
 
+    visitStaticArray :: Env -> XObj -> State Integer (Either TypeError XObj)
+    visitStaticArray env (XObj (StaticArr xobjs) i _) =
+      do visited <- mapM (visit env) xobjs
+         arrayVarTy <- genVarTy
+         lt <- genVarTy
+         return $ do okVisited <- sequence visited
+                     Right (XObj (StaticArr okVisited) i (Just (RefTy (StructTy "StaticArray" [arrayVarTy]) lt)))
+
+    visitStaticArray _ _ = error "The function 'visitStaticArray' only accepts XObj:s with arrays in them."
+
     visitDictionary :: Env -> XObj -> State Integer (Either TypeError XObj)
     visitDictionary env (XObj (Dict xobjs) i _) =
       do visited <- mapM (visit env) xobjs
@@ -179,10 +190,10 @@ initialTypes typeEnv rootEnv root = evalState (visit rootEnv root) 0
                          return (XObj (Lst [defn, nameSymbol, XObj (Arr okArgs) argsi argst, okBody]) i funcTy)
 
         [defn@(XObj (Defn _) _ _), XObj (Sym _ _) _ _, XObj (Arr _) _ _] -> return (Left (NoFormsInBody xobj))
-        (XObj defn@(Defn _) _ _) : _  -> return (Left (InvalidObj defn xobj))
+        XObj defn@(Defn _) _ _ : _  -> return (Left (InvalidObj defn xobj))
 
         -- Fn
-        [fn@(XObj (Fn _ _ _) _ _), XObj (Arr argList) argsi argst, body] ->
+        [fn@(XObj (Fn _ _) _ _), XObj (Arr argList) argsi argst, body] ->
           do (argTypes, returnType, funcScopeEnv) <- getTys env argList
              lt <- genVarTy
              let funcTy = Just (FuncTy argTypes returnType lt)
@@ -193,8 +204,8 @@ initialTypes typeEnv rootEnv root = evalState (visit rootEnv root) 0
                          let final = XObj (Lst [fn, XObj (Arr okArgs) argsi argst, okBody]) i funcTy
                          return final --(trace ("FINAL: " ++ show final) final)
 
-        [XObj (Fn _ _ _ ) _ _, XObj (Arr _) _ _] -> return (Left (NoFormsInBody xobj)) -- TODO: Special error message for lambdas needed?
-        XObj fn@(Fn _ _ _) _ _ : _  -> return (Left (InvalidObj fn xobj))
+        [XObj (Fn _ _ ) _ _, XObj (Arr _) _ _] -> return (Left (NoFormsInBody xobj)) -- TODO: Special error message for lambdas needed?
+        XObj fn@(Fn _ _) _ _ : _  -> return (Left (InvalidObj fn xobj))
 
         -- Def
         [def@(XObj Def _ _), nameSymbol, expression]->

src/Lookup.hs

@@ -164,6 +164,10 @@ getEnv env (p:ps) = case Map.lookup p (envBindings env) of
                       Just _ -> error "Can't get non-env."
                       Nothing -> error "Can't get env."
 
+contextEnv :: Context -> Env
+contextEnv Context{contextInternalEnv=Just e} = e
+contextEnv Context{contextGlobalEnv=e, contextPath=p} = getEnv e p
+
 -- | Checks if an environment is "external", meaning it's either the global scope or a module scope.
 envIsExternal :: Env -> Bool
 envIsExternal env =
@@ -188,7 +192,7 @@ isExternalType _ _ =
 -- | Is this type managed - does it need to be freed?
 isManaged :: TypeEnv -> Ty -> Bool
 isManaged typeEnv (StructTy name _) =
-  (name == "Array") || (name == "Dictionary") || (
+  (name == "Array") || (name == "StaticArray") || (name == "Dictionary") || (
     case lookupInEnv (SymPath [] name) (getTypeEnv typeEnv) of
          Just (_, Binder _ (XObj (Lst (XObj ExternalType _ _ : _)) _ _)) -> False
          Just (_, Binder _ (XObj (Lst (XObj (Deftype _) _ _ : _)) _ _)) -> True
@@ -198,12 +202,12 @@ isManaged typeEnv (StructTy name _) =
     )
 isManaged _ StringTy  = True
 isManaged _ PatternTy = True
-isManaged _ (FuncTy _ _ _) = True
+isManaged _ FuncTy{} = True
 isManaged _ _ = False
 
 -- | Is this type a function type?
 isFunctionType :: Ty -> Bool
-isFunctionType (FuncTy _ _ _) = True
+isFunctionType FuncTy{} = True
 isFunctionType _ = False
 
 -- | Is this type a struct type?

src/Obj.hs

@@ -54,10 +54,12 @@ data Obj = Sym SymPath SymbolMode
          | Bol Bool
          | Lst [XObj]
          | Arr [XObj]
+         | StaticArr [XObj]
          | Dict (Map.Map XObj XObj)
+         | Closure XObj ClosureContext
          | Defn (Maybe (Set.Set XObj)) -- if this is a lifted lambda it needs the set of captured variables
          | Def
-         | Fn (Maybe SymPath) (Set.Set XObj) FnEnv -- the name of the lifted function, the set of variables this lambda captures, and a dynamic environment
+         | Fn (Maybe SymPath) (Set.Set XObj) -- the name of the lifted function, the set of variables this lambda captures, and a dynamic environment
          | Do
          | Let
          | While
@@ -93,7 +95,9 @@ instance Ord Obj where
   compare a b = compare (show a) (show b)
   -- TODO: handle comparison of lists, arrays and dictionaries
 
-newtype CommandFunctionType = CommandFunction { getCommand :: [XObj] -> StateT Context IO (Either EvalError XObj) }
+type CommandCallback = Context -> [XObj] -> IO (Context, (Either EvalError XObj))
+
+newtype CommandFunctionType = CommandFunction { getCommand :: CommandCallback }
 
 instance Eq CommandFunctionType where
   a == b = True
@@ -261,10 +265,11 @@ pretty = visit 0
           case obj xobj of
             Lst lst -> "(" ++ joinWithSpace (map (visit indent) lst) ++ ")"
             Arr arr -> "[" ++ joinWithSpace (map (visit indent) arr) ++ "]"
+            StaticArr arr -> "$[" ++ joinWithSpace (map (visit indent) arr) ++ "]"
             Dict dict -> "{" ++ joinWithSpace (map (visit indent) (concatMap (\(a, b) -> [a, b]) (Map.toList dict))) ++ "}"
             Num IntTy num -> show (round num :: Int)
             Num LongTy num -> show num ++ "l"
-            Num ByteTy num -> show num
+            Num ByteTy num -> show num ++ "b"
             Num FloatTy num -> show num ++ "f"
             Num DoubleTy num -> show num
             Num _ _ -> error "Invalid number type."
@@ -279,7 +284,8 @@ pretty = visit 0
                                               Just captures -> " <" ++ prettyCaptures captures ++ ">"
                                               Nothing -> ""
             Def -> "def"
-            Fn _ captures _ -> "fn" ++ " <" ++ prettyCaptures captures ++ ">"
+            Fn _ captures -> "fn" ++ " <" ++ prettyCaptures captures ++ ">"
+            Closure elem _ -> "closure<" ++ pretty elem ++ ">"
             If -> "if"
             Match -> "match"
             While -> "while"
@@ -308,16 +314,82 @@ pretty = visit 0
             Interface _ _ -> "interface"
             With -> "with"
 
+prettyUpTo :: Int -> XObj -> String
+prettyUpTo max xobj =
+  let prettied = pretty xobj
+  in if length prettied > max
+     then take max prettied ++ "..." ++ end
+     else prettied
+  where end =
+          -- we match all of them explicitly to get errors if we forget one
+          case obj xobj of
+            Lst lst -> ")"
+            Arr arr -> "]"
+            Dict dict -> "}"
+            Num LongTy num -> "l"
+            Num IntTy num -> ""
+            Num ByteTy num -> "b"
+            Num FloatTy num -> show num ++ "f"
+            Num DoubleTy num -> ""
+            Num _ _ -> error "Invalid number type."
+            Str str -> ""
+            Pattern str -> ""
+            Chr c -> ""
+            Sym path mode -> ""
+            MultiSym originalName paths -> "}"
+            InterfaceSym name -> ""
+            Bol b -> ""
+            Defn maybeCaptures ->
+              case maybeCaptures of
+                Just captures -> ">"
+                Nothing -> ""
+            Def -> ""
+            Fn _ captures -> ">"
+            Closure elem _ -> ">"
+            If -> ""
+            Match -> ""
+            While -> ""
+            Do -> ""
+            Let -> ""
+            Mod env -> ""
+            Deftype _ -> ""
+            DefSumtype _ -> ""
+            Deftemplate _ -> ""
+            Instantiate _ -> ""
+            External Nothing -> ""
+            External (Just override) -> ")"
+            ExternalType -> ""
+            DocStub -> ""
+            Defalias _ -> ""
+            Address -> ""
+            SetBang -> ""
+            Macro -> ""
+            Dynamic -> ""
+            DefDynamic -> ""
+            Command _ -> ""
+            The -> ""
+            Ref -> ""
+            Deref -> ""
+            Break -> ""
+            Interface _ _ -> ""
+            With -> ""
+
 prettyCaptures :: Set.Set XObj -> String
 prettyCaptures captures =
   joinWithComma (map (\x -> getName x ++ " : " ++ fromMaybe "" (fmap show (ty x))) (Set.toList captures))
 
-data EvalError = EvalError String (Maybe Info) FilePathPrintLength deriving (Eq)
+data EvalError = EvalError String [XObj] FilePathPrintLength (Maybe Info) deriving (Eq)
 
 instance Show EvalError where
-  show (EvalError msg info fppl) = msg ++ getInfo info
+  show (EvalError msg t fppl i) = msg ++ getInfo i ++ getTrace
     where getInfo (Just i) = " at " ++ machineReadableInfo fppl i ++ "."
           getInfo Nothing = ""
+          getTrace =
+            if null t
+            then ""
+            else
+              "\n\nTraceback:\n" ++
+              unlines (map (\x -> prettyUpTo 60 x ++ getInfo (info x)) t)
 
 -- | Get the type of an XObj as a string.
 typeStr :: XObj -> String
@@ -351,6 +423,8 @@ prettyTyped = visit 0
                  listPrinter "(" ")" lst suffix indent
                Arr arr ->
                  listPrinter "[" "]" arr suffix indent
+               StaticArr arr ->
+                 listPrinter "$[" "]" arr suffix indent
                _ ->
                  pretty xobj ++ suffix
 
@@ -395,7 +469,7 @@ showBinderIndented indent (name, Binder _ (XObj (Lst [XObj (Interface t paths) _
   joinWith "\n    " (map show paths) ++
   "\n" ++ replicate indent ' ' ++ "}"
 showBinderIndented indent (name, Binder meta xobj) =
-  if False -- metaIsTrue meta "hidden"
+  if metaIsTrue meta "hidden"
   then ""
   else replicate indent ' ' ++ name ++
        -- " (" ++ show (getPath xobj) ++ ")" ++
@@ -436,7 +510,7 @@ tyToXObj (StructTy n vs) = XObj (Lst (XObj (Sym (SymPath [] n) Symbol) Nothing N
 tyToXObj (RefTy t lt) = XObj (Lst [XObj (Sym (SymPath [] "Ref") Symbol) Nothing Nothing, tyToXObj t, tyToXObj lt]) Nothing Nothing
 tyToXObj (PointerTy t) = XObj (Lst [XObj (Sym (SymPath [] "Ptr") Symbol) Nothing Nothing, tyToXObj t]) Nothing Nothing
 tyToXObj (FuncTy argTys returnTy StaticLifetimeTy) = XObj (Lst [XObj (Sym (SymPath [] "Fn") Symbol) Nothing Nothing, XObj (Arr (map tyToXObj argTys)) Nothing Nothing, tyToXObj returnTy]) Nothing Nothing
-tyToXObj (FuncTy argTys returnTy lt) = XObj (Lst [(XObj (Sym (SymPath [] "Fn") Symbol) Nothing Nothing), XObj (Arr (map tyToXObj argTys)) Nothing Nothing, tyToXObj returnTy, tyToXObj lt]) Nothing Nothing
+tyToXObj (FuncTy argTys returnTy lt) = XObj (Lst [XObj (Sym (SymPath [] "Fn") Symbol) Nothing Nothing, XObj (Arr (map tyToXObj argTys)) Nothing Nothing, tyToXObj returnTy, tyToXObj lt]) Nothing Nothing
 tyToXObj x = XObj (Sym (SymPath [] (show x)) Symbol) Nothing Nothing
 
 -- | Helper function to create binding pairs for registering external functions.
@@ -457,14 +531,13 @@ data Env = Env { envBindings :: Map.Map String Binder
                , envFunctionNestingLevel :: Int -- Normal defn:s have 0, lambdas get +1 for each level of nesting
                } deriving (Show, Eq)
 
--- Could be (Maybe Env), but we have to get rid of equality
-data FnEnv = None
-           | FEnv Env
+newtype ClosureContext = CCtx Context
   deriving (Show)
 
-instance Eq FnEnv where
+instance Eq ClosureContext where
   _ == _ = True
 
+
 newtype TypeEnv = TypeEnv { getTypeEnv :: Env }
 
 instance Show TypeEnv where
@@ -764,6 +837,9 @@ defineFunctionTypeAlias aliasTy = defineTypeAlias (tyToC aliasTy) aliasTy
 defineArrayTypeAlias :: Ty -> XObj
 defineArrayTypeAlias t = defineTypeAlias (tyToC t) (StructTy "Array" [])
 
+defineStaticArrayTypeAlias :: Ty -> XObj
+defineStaticArrayTypeAlias t = defineTypeAlias (tyToC t) (StructTy "Array" [])
+
 -- |
 defineInterface :: String -> Ty -> [SymPath] -> Maybe Info -> XObj
 defineInterface name t paths info =
@@ -781,16 +857,26 @@ data ExecutionMode = Repl | Build | BuildAndRun | Install String | Check derivin
 
 -- | Information needed by the REPL
 data Context = Context { contextGlobalEnv :: Env
+                       , contextInternalEnv :: Maybe Env
                        , contextTypeEnv :: TypeEnv
                        , contextPath :: [String]
                        , contextProj :: Project
                        , contextLastInput :: String
                        , contextExecMode :: ExecutionMode
+                       , contextHistory :: ![XObj]
                        } deriving Show
 
 popModulePath :: Context -> Context
 popModulePath ctx = ctx { contextPath = init (contextPath ctx) }
 
+pushFrame :: Context -> XObj -> Context
+pushFrame ctx x = ctx { contextHistory = x:contextHistory ctx }
+
+popFrame :: Context -> Context
+popFrame ctx@Context{contextHistory=[]}= ctx
+popFrame ctx@Context{contextHistory=(_:rest)}= ctx { contextHistory = rest }
+
+-- | Unwrapping of XObj:s
 -- | Unwrapping of XObj:s
 
 -- | String

src/Parsing.hs

@@ -101,7 +101,7 @@ parseInternalPattern = do maybeAnchor <- Parsec.optionMaybe (Parsec.char '^')
                           return $ unwrapMaybe maybeAnchor ++ concat str ++
                                    unwrapMaybe maybeEnd
     where unwrapMaybe (Just c) = [c]
-          unwrapMaybe (Nothing) = []
+          unwrapMaybe Nothing  = []
           simple :: Parsec.Parsec String ParseState String
           simple = do char <- Parsec.noneOf "^$()[]\\\""
                       return [char]
@@ -143,22 +143,20 @@ parseInternalPattern = do maybeAnchor <- Parsec.optionMaybe (Parsec.char '^')
             closing <- Parsec.char ']'
             return $ "[" ++ unwrapMaybe maybeAnchor ++ concat str ++ "]"
 
-
-pattern :: Parsec.Parsec String ParseState XObj
-pattern = do i <- createInfo
-             _ <- Parsec.char '#'
-             _ <- Parsec.char '"'
-             str <- parseInternalPattern
-             _ <- Parsec.char '"'
-             incColumn (length str + 2)
-             return (XObj (Pattern $ treat str) i Nothing)
+pat :: Parsec.Parsec String ParseState XObj
+pat = do i <- createInfo
+         _ <- Parsec.string "#\""
+         str <- parseInternalPattern
+         _ <- Parsec.char '"'
+         incColumn (length str + 2)
+         return (XObj (Pattern $ treat str) i Nothing)
   -- auto-escaping backslashes
   where treat :: String -> String
         treat [] = []
         treat ('\\':r) = "\\\\" ++ treat r
         treat (x:r) = x : treat r
 
-escaped :: Parsec.Parsec String ParseState [Char]
+escaped :: Parsec.Parsec String ParseState String
 escaped =  do
     _ <- Parsec.char '\\'
     c <- Parsec.oneOf ['\\', '\"']
@@ -228,7 +226,7 @@ symbol = do i <- createInfo
                 -- TODO: What about the other def- forms?
                 "do" -> return (XObj Do i Nothing)
                 "while" -> return (XObj While i Nothing)
-                "fn" -> return (XObj (Fn Nothing Set.empty None) i Nothing)
+                "fn" -> return (XObj (Fn Nothing Set.empty) i Nothing)
                 "let" -> return (XObj Let i Nothing)
                 "break" -> return (XObj Break i Nothing)
                 "if" -> return (XObj If i Nothing)
@@ -244,7 +242,7 @@ symbol = do i <- createInfo
                 name   -> return (XObj (Sym (SymPath (init segments) name) Symbol) i Nothing)
 
 atom :: Parsec.Parsec String ParseState XObj
-atom = Parsec.choice [number, pattern, string, aChar, symbol]
+atom = Parsec.choice [number, pat, string, aChar, symbol]
 
 incColumn :: Int -> Parsec.Parsec String ParseState ()
 incColumn x = do s <- Parsec.getState
@@ -328,6 +326,16 @@ array = do i <- createInfo
            incColumn 1
            return (XObj (Arr objs) i Nothing)
 
+staticArray :: Parsec.Parsec String ParseState XObj
+staticArray =
+  do i <- createInfo
+     _ <- Parsec.string "$["
+     incColumn 2
+     objs <- readObjs
+     _ <- Parsec.string "]"
+     incColumn 2
+     return (XObj (StaticArr objs) i Nothing)
+
 list :: Parsec.Parsec String ParseState XObj
 list = do i <- createInfo
           _ <- Parsec.char '('
@@ -350,7 +358,7 @@ dictionary = do i <- createInfo
                     pairInit = XObj (Sym (SymPath ["Pair"] "init") (LookupGlobal CarpLand AFunction)) i Nothing
                     pairs = map (\(k,v) -> XObj (Lst [pairInit, k, v]) i Nothing) (pairwise objs')
                     arrayLiteral = XObj (Arr pairs) i Nothing
-                    reffedArrayLiteral = XObj (Lst [(XObj Ref i Nothing), arrayLiteral]) i Nothing
+                    reffedArrayLiteral = XObj (Lst [XObj Ref i Nothing, arrayLiteral]) i Nothing
                     fromArraySymbol = XObj (Sym (SymPath ["Map"] "from-array") (LookupGlobal CarpLand AFunction)) i Nothing
                     fromArraySexp = XObj (Lst [fromArraySymbol, reffedArrayLiteral]) i Nothing
                 return fromArraySexp
@@ -387,7 +395,7 @@ quote = do i1 <- createInfo
            return (XObj (Lst [XObj (Sym (SymPath [] "quote") Symbol) i1 Nothing, expr]) i2 Nothing)
 
 sexpr :: Parsec.Parsec String ParseState XObj
-sexpr = do x <- Parsec.choice [ref, deref, copy, quote, list, array, dictionary, atom]
+sexpr = do x <- Parsec.choice [ref, deref, copy, quote, list, staticArray, array, dictionary, atom]
            _ <- whitespaceOrNothing
            return x
 
@@ -415,8 +423,7 @@ balance text =
   where
         parenSyntax :: Parsec.Parsec String [Char] Int
         parenSyntax = do _ <- Parsec.many character
-                         parens <- Parsec.getState
-                         return (length parens)
+                         length <$> Parsec.getState
 
         character :: Parsec.Parsec String [Char] ()
         character = do c <- Parsec.anyChar

src/Primitives.hs

@@ -0,0 +1,552 @@
+module Primitives where
+
+import Control.Monad (unless, when, foldM)
+import Control.Monad.IO.Class (liftIO)
+import Data.List (foldl')
+import qualified Data.Map as Map
+
+import ColorText
+import Commands
+import Deftype
+import Emit
+import Lookup
+import Obj
+import Sumtypes
+import TypeError
+import Types
+import Util
+
+import Debug.Trace
+
+type Primitive = XObj -> Context -> [XObj] -> IO (Context, Either EvalError XObj)
+
+found ctx binder =
+  liftIO $ do putStrLnWithColor White (show binder)
+              return (ctx, dynamicNil)
+
+makePrim :: String -> Int -> String -> Primitive -> (SymPath, Primitive)
+makePrim name arity example callback =
+  makePrim' name (Just arity) example callback
+
+makeVarPrim :: String -> String -> Primitive -> (SymPath, Primitive)
+makeVarPrim name example callback =
+  makePrim' name Nothing example callback
+
+argumentErr :: Context -> String -> String -> String -> XObj -> IO (Context, Either EvalError XObj)
+argumentErr ctx fun ty number actual =
+  return (evalError ctx (
+            "`" ++ fun ++ "` expected " ++ ty ++ " as its " ++ number ++
+            " argument, but got `" ++ pretty actual ++ "`") (info actual))
+
+makePrim' :: String -> Maybe Int -> String -> Primitive -> (SymPath, Primitive)
+makePrim' name maybeArity example callback =
+  let path = SymPath [] name
+  in (path, wrapped)
+  where wrapped =
+          case maybeArity of
+            Just a ->
+              \x c l ->
+                let ll = length l
+                in (if ll /= a then err x c a ll else callback x c l)
+            Nothing -> callback
+        err :: XObj -> Context -> Int -> Int -> IO (Context, Either EvalError XObj)
+        err x ctx a l =
+          return (evalError ctx (
+            "The primitive `" ++ name ++ "` expected " ++ show a ++
+            " arguments, but got " ++ show l ++ ".\n\nExample Usage:\n```\n" ++
+            example ++ "\n```\n") (info x))
+
+primitiveFile :: Primitive
+primitiveFile x@(XObj _ i t) ctx [] =
+  case i of
+    Just info -> return (ctx, Right (XObj (Str (infoFile info)) i t))
+    Nothing ->
+      return (evalError ctx ("No information about object " ++ pretty x) (info x))
+primitiveFile x@(XObj _ i t) ctx [XObj _ mi _] =
+  case mi of
+    Just info -> return (ctx, Right (XObj (Str (infoFile info)) i t))
+    Nothing ->
+      return (evalError ctx ("No information about object " ++ pretty x) (info x))
+primitiveFile x@(XObj _ i t) ctx args =
+  return (
+    evalError ctx
+      ("`file` expected 0 or 1 arguments, but got " ++ show (length args))
+      (info x))
+
+primitiveLine :: Primitive
+primitiveLine x@(XObj _ i t) ctx [] =
+  case i of
+    Just info -> return (ctx, Right (XObj (Num IntTy (fromIntegral (infoLine info))) i t))
+    Nothing ->
+      return (evalError ctx ("No information about object " ++ pretty x) (info x))
+primitiveLine x@(XObj _ i t) ctx [XObj _ mi _] =
+  case mi of
+    Just info -> return (ctx, Right (XObj (Num IntTy (fromIntegral (infoLine info))) i t))
+    Nothing ->
+      return (evalError ctx ("No information about object " ++ pretty x) (info x))
+primitiveLine x@(XObj _ i t) ctx args =
+  return (
+    evalError ctx
+      ("`line` expected 0 or 1 arguments, but got " ++ show (length args))
+      (info x))
+
+primitiveColumn :: Primitive
+primitiveColumn x@(XObj _ i t) ctx [] =
+  case i of
+    Just info -> return (ctx, Right (XObj (Num IntTy (fromIntegral (infoColumn info))) i t))
+    Nothing ->
+      return (evalError ctx ("No information about object " ++ pretty x) (info x))
+primitiveColumn x@(XObj _ i t) ctx [XObj _ mi _] =
+  case mi of
+    Just info -> return (ctx, Right (XObj (Num IntTy (fromIntegral (infoColumn info))) i t))
+    Nothing ->
+      return (evalError ctx ("No information about object " ++ pretty x) (info x))
+primitiveColumn x@(XObj _ i t) ctx args =
+  return (
+    evalError ctx
+      ("`column` expected 0 or 1 arguments, but got " ++ show (length args))
+      (info x))
+
+registerInInterfaceIfNeeded :: Context -> SymPath -> Ty -> Either String Context
+registerInInterfaceIfNeeded ctx path@(SymPath _ name) definitionSignature =
+  let typeEnv = getTypeEnv (contextTypeEnv ctx)
+  in case lookupInEnv (SymPath [] name) typeEnv of
+       Just (_, Binder _ (XObj (Lst [XObj (Interface interfaceSignature paths) ii it, isym]) i t)) ->
+         if areUnifiable interfaceSignature definitionSignature
+         then let updatedInterface = XObj (Lst [XObj (Interface interfaceSignature (addIfNotPresent path paths)) ii it, isym]) i t
+              in  return $ ctx { contextTypeEnv = TypeEnv (extendEnv typeEnv name updatedInterface) }
+         else Left ("[INTERFACE ERROR] " ++ show path ++ " : " ++ show definitionSignature ++
+                    " doesn't match the interface signature " ++ show interfaceSignature)
+       Just (_, Binder _ x) ->
+         error ("A non-interface named '" ++ name ++ "' was found in the type environment: " ++ show x)
+       Nothing -> return ctx
+
+-- | Ensure that a 'def' / 'defn' has registered with an interface (if they share the same name).
+registerDefnOrDefInInterfaceIfNeeded :: Context -> XObj -> Either String Context
+registerDefnOrDefInInterfaceIfNeeded ctx xobj =
+  case xobj of
+    XObj (Lst [XObj (Defn _) _ _, XObj (Sym path _) _ _, _, _]) _ (Just t) ->
+      -- This is a function, does it belong to an interface?
+      registerInInterfaceIfNeeded ctx path t
+    XObj (Lst [XObj Def _ _, XObj (Sym path _) _ _, _]) _ (Just t) ->
+      -- Global variables can also be part of an interface
+      registerInInterfaceIfNeeded ctx path t
+    _ -> return ctx
+
+define :: Bool -> Context -> XObj -> IO Context
+define hidden ctx@(Context globalEnv _ typeEnv _ proj _ _ _) annXObj =
+  let previousType =
+        case lookupInEnv (getPath annXObj) globalEnv of
+          Just (_, Binder _ found) -> ty found
+          Nothing -> Nothing
+      previousMeta = existingMeta globalEnv annXObj
+      adjustedMeta = if hidden
+                     then previousMeta { getMeta = Map.insert "hidden" trueXObj (getMeta previousMeta) }
+                     else previousMeta
+      fppl = projectFilePathPrintLength proj
+  in case annXObj of
+       XObj (Lst (XObj (Defalias _) _ _ : _)) _ _ ->
+         return (ctx { contextTypeEnv = TypeEnv (envInsertAt (getTypeEnv typeEnv) (getPath annXObj) (Binder adjustedMeta annXObj)) })
+       XObj (Lst (XObj (Deftype _) _ _ : _)) _ _ ->
+         return (ctx { contextTypeEnv = TypeEnv (envInsertAt (getTypeEnv typeEnv) (getPath annXObj) (Binder adjustedMeta annXObj)) })
+       XObj (Lst (XObj (DefSumtype _) _ _ : _)) _ _ ->
+         return (ctx { contextTypeEnv = TypeEnv (envInsertAt (getTypeEnv typeEnv) (getPath annXObj) (Binder adjustedMeta annXObj)) })
+       _ ->
+         do when (projectEchoC proj) $
+              putStrLn (toC All (Binder emptyMeta annXObj))
+            case previousType of
+              Just previousTypeUnwrapped ->
+                unless (areUnifiable (forceTy annXObj) previousTypeUnwrapped) $
+                  do putStrWithColor Blue ("[WARNING] Definition at " ++ prettyInfoFromXObj annXObj ++ " changed type of '" ++ show (getPath annXObj) ++
+                                           "' from " ++ show previousTypeUnwrapped ++ " to " ++ show (forceTy annXObj))
+                     putStrLnWithColor White "" -- To restore color for sure.
+              Nothing -> return ()
+            case registerDefnOrDefInInterfaceIfNeeded ctx annXObj of
+              Left err ->
+                do case contextExecMode ctx of
+                     Check -> let fppl = projectFilePathPrintLength (contextProj ctx)
+                              in  putStrLn (machineReadableInfoFromXObj fppl annXObj ++ " " ++ err)
+                     _ -> putStrLnWithColor Red err
+                   return ctx
+              Right ctx' ->
+                return (ctx' { contextGlobalEnv = envInsertAt globalEnv (getPath annXObj) (Binder adjustedMeta annXObj) })
+
+primitiveRegisterType :: Primitive
+primitiveRegisterType _ ctx [XObj (Sym (SymPath [] t) _) _ _] = do
+  let pathStrings = contextPath ctx
+      typeEnv = contextTypeEnv ctx
+      path = SymPath pathStrings t
+      typeDefinition = XObj (Lst [XObj ExternalType Nothing Nothing, XObj (Sym path Symbol) Nothing Nothing]) Nothing (Just TypeTy)
+  return (ctx { contextTypeEnv = TypeEnv (extendEnv (getTypeEnv typeEnv) t typeDefinition) }, dynamicNil)
+primitiveRegisterType _ ctx [x] =
+  return (evalError ctx ("`register-type` takes a symbol, but it got " ++ pretty x) (info x))
+primitiveRegisterType _ ctx (x@(XObj (Sym (SymPath [] t) _) _ _):members) = do
+  let pathStrings = contextPath ctx
+      globalEnv = contextGlobalEnv ctx
+      typeEnv = contextTypeEnv ctx
+      path = SymPath pathStrings t
+      preExistingModule = case lookupInEnv (SymPath pathStrings t) globalEnv of
+                            Just (_, Binder _ (XObj (Mod found) _ _)) -> Just found
+                            _ -> Nothing
+  case bindingsForRegisteredType typeEnv globalEnv pathStrings t members Nothing preExistingModule of
+    Left err -> return (makeEvalError ctx (Just err) (show err) (info x))
+    Right (typeModuleName, typeModuleXObj, deps) -> do
+      let typeDefinition = XObj (Lst [XObj ExternalType Nothing Nothing, XObj (Sym path Symbol) Nothing Nothing]) Nothing (Just TypeTy)
+          ctx' = (ctx { contextGlobalEnv = envInsertAt globalEnv (SymPath pathStrings typeModuleName) (Binder emptyMeta typeModuleXObj)
+                      , contextTypeEnv = TypeEnv (extendEnv (getTypeEnv typeEnv) t typeDefinition)
+                      })
+      contextWithDefs <- liftIO $ foldM (define True) ctx' deps
+      return (contextWithDefs, dynamicNil)
+
+notFound :: Context -> XObj -> SymPath -> IO (Context, Either EvalError XObj)
+notFound ctx x path =
+  return (evalError ctx ("I can’t find the symbol `" ++ show path ++ "`") (info x))
+
+primitiveInfo :: Primitive
+primitiveInfo _ ctx [target@(XObj (Sym path@(SymPath _ name) _) _ _)] = do
+  let env = contextEnv ctx
+      typeEnv = contextTypeEnv ctx
+  case path of
+    SymPath [] _ ->
+      -- First look in the type env, then in the global env:
+      case lookupInEnv path (getTypeEnv typeEnv) of
+        Nothing -> printer env True True (lookupInEnv path env)
+        found -> do printer env True True found -- this will print the interface itself
+                    printer env True False (lookupInEnv path env)-- this will print the locations of the implementers of the interface
+    qualifiedPath ->
+      case lookupInEnv path env of
+        Nothing -> notFound ctx target path
+        found -> printer env False True found
+  where printer env allowLookupInALL errNotFound binderPair = do
+          let proj = contextProj ctx
+          case binderPair of
+           Just (_, binder@(Binder metaData x@(XObj _ (Just i) _))) ->
+             do liftIO $ putStrLn (show binder ++ "\nDefined at " ++ prettyInfo i)
+                printDoc metaData proj x
+           Just (_, binder@(Binder metaData x)) ->
+             do liftIO $ print binder
+                printDoc metaData proj x
+           Nothing | allowLookupInALL ->
+            case multiLookupALL name env of
+                [] -> if errNotFound then notFound ctx target path else
+                        return (ctx,  dynamicNil)
+                binders -> do liftIO $
+                                mapM_
+                                  (\ (env, binder@(Binder _ (XObj _ i _))) ->
+                                     case i of
+                                         Just i' -> putStrLnWithColor White
+                                                      (show binder ++ " Defined at " ++ prettyInfo i')
+                                         Nothing -> putStrLnWithColor White (show binder))
+                                  binders
+                              return (ctx, dynamicNil)
+                   | errNotFound -> notFound ctx target path
+                   | otherwise -> return (ctx, dynamicNil)
+        printDoc metaData proj x = do
+          case Map.lookup "doc" (getMeta metaData) of
+            Just (XObj (Str val) _ _) -> liftIO $ putStrLn ("Documentation: " ++ val)
+            Nothing -> return ()
+          liftIO $ when (projectPrintTypedAST proj) $ putStrLnWithColor Yellow (prettyTyped x)
+          return (ctx, dynamicNil)
+primitiveInfo _ ctx [notName] =
+  argumentErr ctx "info" "a name" "first" notName
+
+dynamicOrMacroWith :: Context -> (SymPath -> [XObj]) -> Ty -> String -> XObj -> IO (Context, Either EvalError XObj)
+dynamicOrMacroWith ctx producer ty name body = do
+  let pathStrings = contextPath ctx
+      globalEnv = contextGlobalEnv ctx
+      path = SymPath pathStrings name
+      elem = XObj (Lst (producer path)) (info body) (Just ty)
+      meta = existingMeta globalEnv elem
+  return (ctx { contextGlobalEnv = envInsertAt globalEnv path (Binder meta elem) }, dynamicNil)
+
+primitiveType :: Primitive
+primitiveType _ ctx [x@(XObj (Sym path@(SymPath [] name) _) _ _)] = do
+  let env = contextGlobalEnv ctx
+  case lookupInEnv path env of
+    Just (_, binder) ->
+      found ctx binder
+    Nothing ->
+      case multiLookupALL name env of
+        [] ->
+          notFound ctx x path
+        binders ->
+          liftIO $ do mapM_ (\(env, binder) -> putStrLnWithColor White (show binder)) binders
+                      return (ctx, dynamicNil)
+primitiveType _ ctx [x@(XObj (Sym qualifiedPath _) _ _)] = do
+  let env = contextGlobalEnv ctx
+  case lookupInEnv qualifiedPath env of
+    Just (_, binder) -> found ctx binder
+    Nothing -> notFound ctx x qualifiedPath
+primitiveType _ ctx [x] =
+  return (evalError ctx ("Can't get the type of non-symbol: " ++ pretty x) (info x))
+
+primitiveMembers :: Primitive
+primitiveMembers _ ctx [target] = do
+  let env = contextEnv ctx
+      typeEnv = contextTypeEnv ctx
+      fppl = projectFilePathPrintLength (contextProj ctx)
+  case bottomedTarget env target of
+        XObj (Sym path@(SymPath _ name) _) _ _ ->
+           case lookupInEnv path (getTypeEnv typeEnv) of
+             Just (_, Binder _ (XObj (Lst [
+               XObj (Deftype structTy) Nothing Nothing,
+               XObj (Sym (SymPath pathStrings typeName) Symbol) Nothing Nothing,
+               XObj (Arr members) _ _]) _ _))
+               ->
+                 return (ctx, Right (XObj (Arr (map (\(a, b) -> XObj (Lst [a, b]) Nothing Nothing) (pairwise members))) Nothing Nothing))
+             Just (_, Binder _ (XObj (Lst (
+               XObj (DefSumtype structTy) Nothing Nothing :
+               XObj (Sym (SymPath pathStrings typeName) Symbol) Nothing Nothing :
+               sumtypeCases)) _ _))
+               ->
+                 return (ctx, Right (XObj (Arr (concatMap getMembersFromCase sumtypeCases)) Nothing Nothing))
+               where getMembersFromCase :: XObj -> [XObj]
+                     getMembersFromCase (XObj (Lst members) _ _) =
+                       map (\(a, b) -> XObj (Lst [a, b]) Nothing Nothing) (pairwise members)
+                     getMembersFromCase x@(XObj (Sym sym _) _ _) =
+                       [XObj (Lst [x, XObj (Arr []) Nothing Nothing]) Nothing Nothing]
+                     getMembersFromCase (XObj x _ _) =
+                       error ("Can't handle case " ++ show x)
+             _ ->
+               return (evalError ctx ("Can't find a struct type named '" ++ name ++ "' in type environment") (info target))
+        _ -> return (evalError ctx ("Can't get the members of non-symbol: " ++ pretty target) (info target))
+  where bottomedTarget env target =
+          case target of
+            XObj (Sym targetPath _) _ _ ->
+              case lookupInEnv targetPath env of
+                -- this is a trick: every type generates a module in the env;
+                -- we’re special-casing here because we need the parent of the
+                -- module
+                Just (_, Binder _ (XObj (Mod _) _ _)) -> target
+                -- if we’re recursing into a non-sym, we’ll stop one level down
+                Just (_, Binder _ x) -> bottomedTarget env x
+                _ -> target
+            _ -> target
+
+-- | Set meta data for a Binder
+primitiveMetaSet :: Primitive
+primitiveMetaSet _ ctx [target@(XObj (Sym path@(SymPath _ name) _) _ _), XObj (Str key) _ _, value] = do
+  let env = contextGlobalEnv ctx
+      pathStrings = contextPath ctx
+      fppl = projectFilePathPrintLength (contextProj ctx)
+  case lookupInEnv (consPath pathStrings path) env of
+    Just (_, binder@(Binder _ xobj)) ->
+      -- | Set meta on existing binder
+      setMetaOn ctx binder
+    Nothing ->
+      case path of
+        -- | If the path is unqualified, create a binder and set the meta on that one. This enables docstrings before function exists.
+        (SymPath [] name) ->
+          setMetaOn ctx (Binder emptyMeta (XObj (Lst [XObj DocStub Nothing Nothing,
+                                                      XObj (Sym (SymPath pathStrings name) Symbol) Nothing Nothing])
+                                           (Just dummyInfo)
+                                           (Just (VarTy "a"))))
+        (SymPath _ _) ->
+          return (evalError ctx ("`meta-set!` failed, I can't find the symbol `" ++ show path ++ "`") (info target))
+    where
+      setMetaOn :: Context -> Binder -> IO (Context, Either EvalError XObj)
+      setMetaOn ctx binder@(Binder metaData xobj) =
+        do let globalEnv = contextGlobalEnv ctx
+               newMetaData = MetaData (Map.insert key value (getMeta metaData))
+               xobjPath = getPath xobj
+               newBinder = binder { binderMeta = newMetaData }
+               newEnv = envInsertAt globalEnv xobjPath newBinder
+           return (ctx { contextGlobalEnv = newEnv }, dynamicNil)
+primitiveMetaSet _ ctx [XObj (Sym _ _) _ _, key, _] =
+  argumentErr ctx "meta-set!" "a string" "second" key
+primitiveMetaSet _ ctx [target, _, _] =
+  argumentErr ctx "meta-set!" "a symbol" "first" target
+
+retroactivelyRegisterInterfaceFunctions :: Context -> String -> Ty -> IO Context
+retroactivelyRegisterInterfaceFunctions ctx name t = do
+  let env = contextGlobalEnv ctx
+      found = multiLookupALL name env
+      binders = map snd found
+      resultCtx = foldl' (\maybeCtx binder -> case maybeCtx of
+                                                Right ok -> registerDefnOrDefInInterfaceIfNeeded ok (binderXObj binder)
+                                                Left err -> Left err)
+                         (Right ctx) binders
+  case resultCtx of
+    Left err -> error err
+    Right ctx' -> return ctx'
+
+primitiveDefinterface :: Primitive
+primitiveDefinterface xobj ctx [nameXObj@(XObj (Sym path@(SymPath [] name) _) _ _), ty] = do
+  let fppl = projectFilePathPrintLength (contextProj ctx)
+      typeEnv = getTypeEnv (contextTypeEnv ctx)
+  case xobjToTy ty of
+    Just t ->
+      case lookupInEnv path typeEnv of
+        Just (_, Binder _ (XObj (Lst (XObj (Interface foundType _) _ _ : _)) _ _)) ->
+          -- The interface already exists, so it will be left as-is.
+          if foundType == t
+          then return (ctx, dynamicNil)
+          else return (evalError ctx ("Tried to change the type of interface `" ++ show path ++ "` from `" ++ show foundType ++ "` to `" ++ show t ++ "`") (info xobj))
+        Nothing ->
+          let interface = defineInterface name t [] (info nameXObj)
+              typeEnv' = TypeEnv (envInsertAt typeEnv (SymPath [] name) (Binder emptyMeta interface))
+          in  do
+                 newCtx <- retroactivelyRegisterInterfaceFunctions (ctx { contextTypeEnv = typeEnv' }) name t
+                 return (newCtx, dynamicNil)
+    Nothing ->
+      return (evalError ctx ("Invalid type for interface `" ++ name ++ "`: " ++ pretty ty) (info ty))
+primitiveDefinterface _ ctx [name, _] = do
+  return (evalError ctx ("`definterface` expects a name as first argument, but got `" ++ pretty name ++ "`") (info name))
+
+registerInternal :: Context -> String -> XObj -> Maybe String -> IO (Context, Either EvalError XObj)
+registerInternal ctx name ty override = do
+  let pathStrings = contextPath ctx
+      fppl = projectFilePathPrintLength (contextProj ctx)
+      globalEnv = contextGlobalEnv ctx
+  case xobjToTy ty of
+        Just t ->
+          let path = SymPath pathStrings name
+              registration = XObj (Lst [XObj (External override) Nothing Nothing,
+                                        XObj (Sym path Symbol) Nothing Nothing])
+                             (info ty) (Just t)
+              meta = existingMeta globalEnv registration
+              env' = envInsertAt globalEnv path (Binder meta registration)
+          in  case registerInInterfaceIfNeeded ctx path t of
+                Left errorMessage ->
+                  return (makeEvalError ctx Nothing errorMessage (info ty))
+                Right ctx' ->
+                  do return (ctx' { contextGlobalEnv = env' }, dynamicNil)
+        Nothing ->
+          return (evalError ctx
+            ("Can't understand type when registering '" ++ name ++ "'") (info ty))
+
+primitiveRegister :: Primitive
+primitiveRegister _ ctx [XObj (Sym (SymPath _ name) _) _ _, ty] =
+  registerInternal ctx name ty Nothing
+primitiveRegister _ ctx [name, _] =
+  return (evalError ctx
+    ("`register` expects a name as first argument, but got `" ++ pretty name ++ "`")
+    (info name))
+primitiveRegister _ ctx [XObj (Sym (SymPath _ name) _) _ _, ty, XObj (Str override) _ _] =
+  registerInternal ctx name ty (Just override)
+primitiveRegister _ ctx [XObj (Sym (SymPath _ name) _) _ _, _, override] =
+  return (evalError ctx
+    ("`register` expects a string as third argument, but got `" ++ pretty override ++ "`")
+    (info override))
+primitiveRegister _ ctx [name, _, _] =
+  return (evalError ctx
+    ("`register` expects a name as first argument, but got `" ++ pretty name ++ "`")
+    (info name))
+primitiveRegister x ctx _ =
+  return (evalError ctx
+    ("I didn’t understand the form `" ++ pretty x ++
+     "`.\n\nIs it valid? Every `register` needs to follow the form `(register name <signature> <optional: override>)`.")
+    (info x))
+
+primitiveDeftype :: Primitive
+primitiveDeftype xobj ctx (name:rest) =
+  case rest of
+    (XObj (Arr a) _ _ : _) -> if all isUnqualifiedSym (map fst (members a))
+                             then deftype name
+                             else return (makeEvalError ctx Nothing (
+                                  "Type members must be unqualified symbols, but got `" ++
+                                  concatMap pretty rest ++ "`") (info xobj))
+                             where members (binding:val:xs) = (binding, val):members xs
+                                   members [] = []
+    _ -> deftype name
+  where deftype name@(XObj (Sym (SymPath _ ty) _) _ _) = deftype' name ty []
+        deftype (XObj (Lst (name@(XObj (Sym (SymPath _ ty) _) _ _) : tyvars)) _ _) =
+          deftype' name ty tyvars
+        deftype name =
+          return (evalError ctx
+                   ("Invalid name for type definition: " ++ pretty name)
+                   (info name))
+        deftype' :: XObj -> String -> [XObj] -> IO (Context, Either EvalError XObj)
+        deftype' nameXObj typeName typeVariableXObjs = do
+         let pathStrings = contextPath ctx
+             fppl = projectFilePathPrintLength (contextProj ctx)
+             env = contextGlobalEnv ctx
+             typeEnv = contextTypeEnv ctx
+             typeVariables = mapM xobjToTy typeVariableXObjs
+             (preExistingModule, existingMeta) =
+               case lookupInEnv (SymPath pathStrings typeName) env of
+                 Just (_, Binder existingMeta (XObj (Mod found) _ _)) -> (Just found, existingMeta)
+                 Just (_, Binder existingMeta _) -> (Nothing, existingMeta)
+                 _ -> (Nothing, emptyMeta)
+             (creatorFunction, typeConstructor) =
+                if length rest == 1 && isArray (head rest)
+                then (moduleForDeftype, Deftype)
+                else (moduleForSumtype, DefSumtype)
+         case (nameXObj, typeVariables) of
+           (XObj (Sym (SymPath _ typeName) _) i _, Just okTypeVariables) ->
+             case creatorFunction typeEnv env pathStrings typeName okTypeVariables rest i preExistingModule of
+               Right (typeModuleName, typeModuleXObj, deps) ->
+                 let structTy = StructTy typeName okTypeVariables
+                     typeDefinition =
+                       -- NOTE: The type binding is needed to emit the type definition and all the member functions of the type.
+                       XObj (Lst (XObj (typeConstructor structTy) Nothing Nothing :
+                                  XObj (Sym (SymPath pathStrings typeName) Symbol) Nothing Nothing :
+                                  rest)
+                            ) i (Just TypeTy)
+                     ctx' = (ctx { contextGlobalEnv = envInsertAt env (SymPath pathStrings typeModuleName) (Binder existingMeta typeModuleXObj)
+                                 , contextTypeEnv = TypeEnv (extendEnv (getTypeEnv typeEnv) typeName typeDefinition)
+                                 })
+                 in do ctxWithDeps <- liftIO (foldM (define True) ctx' deps)
+                       let ctxWithInterfaceRegistrations =
+                             foldM (\context (path, sig) -> registerInInterfaceIfNeeded context path sig) ctxWithDeps
+                                   [(SymPath (pathStrings ++ [typeModuleName]) "str", FuncTy [RefTy structTy (VarTy "q")] StringTy StaticLifetimeTy)
+                                   ,(SymPath (pathStrings ++ [typeModuleName]) "copy", FuncTy [RefTy structTy (VarTy "q")] structTy StaticLifetimeTy)]
+                       case ctxWithInterfaceRegistrations of
+                         Left err -> do
+                          liftIO (putStrLnWithColor Red err)
+                          return (ctx, dynamicNil)
+                         Right ok -> return (ok, dynamicNil)
+               Left err ->
+                 return (makeEvalError ctx (Just err) ("Invalid type definition for '" ++ pretty nameXObj ++ "':\n\n" ++ show err) Nothing)
+           (_, Nothing) ->
+             return (makeEvalError ctx Nothing ("Invalid type variables for type definition: " ++ pretty nameXObj) (info nameXObj))
+
+primitiveUse :: Primitive
+primitiveUse xobj ctx [XObj (Sym path _) _ _] = do
+  let pathStrings = contextPath ctx
+      fppl = projectFilePathPrintLength (contextProj ctx)
+      env = contextGlobalEnv ctx
+      e = getEnv env pathStrings
+      useThese = envUseModules e
+      e' = if path `elem` useThese then e else e { envUseModules = path : useThese }
+  case lookupInEnv path e of
+    Just (_, Binder _ _) ->
+      return (ctx { contextGlobalEnv = envReplaceEnvAt env pathStrings e' }, dynamicNil)
+    Nothing ->
+      case lookupInEnv path env of
+        Just (_, Binder _ _) ->
+          return (ctx { contextGlobalEnv = envReplaceEnvAt env pathStrings e' }, dynamicNil)
+        Nothing ->
+          return (evalError ctx
+                   ("Can't find a module named '" ++ show path ++ "'") (info xobj))
+
+-- | Get meta data for a Binder
+primitiveMeta :: Primitive
+primitiveMeta (XObj _ i _) ctx [XObj (Sym path _) _ _, XObj (Str key) _ _] = do
+  let pathStrings = contextPath ctx
+      fppl = projectFilePathPrintLength (contextProj ctx)
+      globalEnv = contextGlobalEnv ctx
+  case lookupInEnv (consPath pathStrings path) globalEnv of
+    Just (_, Binder metaData _) ->
+        case Map.lookup key (getMeta metaData) of
+          Just foundValue ->
+            return (ctx, Right foundValue)
+          Nothing ->
+            return (ctx, dynamicNil)
+    Nothing ->
+      return (evalError ctx
+                        ("`meta` failed, I can’t find `" ++ show path ++ "`")
+                        i)
+primitiveMeta _ ctx [XObj (Sym path _) _ _, key@(XObj _ i _)] =
+  argumentErr ctx "meta" "a string" "second" key
+primitiveMeta _ ctx [path@(XObj _ i _), _] =
+  argumentErr ctx "meta" "a symbol" "first" path
+
+primitiveDefined :: Primitive
+primitiveDefined _ ctx [XObj (Sym path _) _ _] = do
+  let env = contextEnv ctx
+  case lookupInEnv path env of
+    Just found -> return (ctx, Right trueXObj)
+    Nothing -> return (ctx, Right falseXObj)
+primitiveDefined _ ctx [arg] =
+  argumentErr ctx "defined" "a symbol" "first" arg

src/Qualify.hs

@@ -37,7 +37,7 @@ setFullyQualifiedSymbols typeEnv globalEnv env (XObj (Lst [defn@(XObj (Defn _) _
       functionEnv = Env Map.empty (Just envWithSelf) Nothing [] InternalEnv 0
       envWithArgs = foldl' (\e arg@(XObj (Sym (SymPath _ argSymName) _) _ _) -> extendEnv e argSymName arg) functionEnv argsArr
   in  XObj (Lst [defn, sym, args, setFullyQualifiedSymbols typeEnv globalEnv envWithArgs body]) i t
-setFullyQualifiedSymbols typeEnv globalEnv env (XObj (Lst [fn@(XObj (Fn _ _ _) _ _),
+setFullyQualifiedSymbols typeEnv globalEnv env (XObj (Lst [fn@(XObj (Fn _ _) _ _),
                                                  args@(XObj (Arr argsArr) _ _),
                                                  body])
                                       i t) =
@@ -147,7 +147,7 @@ setFullyQualifiedSymbols typeEnv globalEnv localEnv xobj@(XObj (Sym path _) i t)
               (e, Binder _ local) : _ -> XObj (Sym (getPath local) (LookupLocal (captureOrNot e))) i t
             -- There are no local bindings, this is allowed to become a multi lookup symbol:
               [] ->
-                --(trace $ "Turned " ++ show path ++ " into multisym: " ++ joinWithComma (map (show . (\(e, b) -> (getPath (binderXObj b), safeEnvModuleName e, envMode e))) multiple)) $
+                -- (trace $ "Turned " ++ show path ++ " into multisym: " ++ joinWithComma (map (show . (\(e, b) -> (getPath (binderXObj b), safeEnvModuleName e, envMode e))) multiple)) $
                 case path of
                   (SymPath [] name) ->
                      -- Create a MultiSym!
@@ -172,6 +172,11 @@ setFullyQualifiedSymbols typeEnv globalEnv localEnv xobj@(XObj (Sym path _) i t)
 setFullyQualifiedSymbols typeEnv globalEnv env xobj@(XObj (Arr array) i t) =
   let array' = map (setFullyQualifiedSymbols typeEnv globalEnv env) array
   in  XObj (Arr array') i t
+
+setFullyQualifiedSymbols typeEnv globalEnv env xobj@(XObj (StaticArr array) i t) =
+  let array' = map (setFullyQualifiedSymbols typeEnv globalEnv env) array
+  in  XObj (StaticArr array') i t
+
 setFullyQualifiedSymbols _ _ _ xobj = xobj
 
 isExternalFunction :: XObj -> Bool

src/Repl.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}
 module Repl where
 
 import System.Console.Haskeline ( getInputLine
@@ -10,6 +11,9 @@ import System.Console.Haskeline ( getInputLine
                                 )
 import Data.List (isPrefixOf)
 import Control.Monad.IO.Class (liftIO)
+import Control.Monad.State.Strict
+import System.Exit (exitSuccess)
+import qualified Data.Map as Map
 
 import Types
 import Obj
@@ -17,10 +21,17 @@ import Util
 import ColorText
 import Eval
 import Path
+import Lookup
 import Parsing (balance)
 
-completeKeywordsAnd :: Monad m => [String ] -> String -> String -> m [Completion]
-completeKeywordsAnd words _ word = return $ findKeywords word (words ++ keywords) []
+instance MonadState s m => MonadState s (InputT m) where
+    get = lift get
+    put = lift . put
+    state = lift . state
+
+completeKeywordsAnd :: Context -> String -> [Completion]
+completeKeywordsAnd context word = do
+  findKeywords word ((bindingNames $ contextGlobalEnv context) ++ keywords) []
   where
         findKeywords match [] res = res
         findKeywords match (x : xs) res =
@@ -66,31 +77,77 @@ completeKeywordsAnd words _ word = return $ findKeywords word (words ++ keywords
                    ]
 
 
-readlineSettings :: Monad m => [String] -> IO (Settings m)
-readlineSettings words = do
-  historyFile <- configPath "history"
-  createDirectoryIfMissing True (takeDirectory historyFile)
-  return $ Settings {
-    complete = completeWordWithPrev Nothing ['(', ')', '[', ']', ' ', '\t', '\n'] (completeKeywordsAnd words),
+readlineSettings :: String -> Settings (StateT Context IO)
+readlineSettings historyFile =
+  Settings {
+    complete = completeWordWithPrev Nothing ['(', ')', '[', ']', ' ', '\t', '\n']
+                  (\_ w -> do
+                      ctx <- get
+                      return (completeKeywordsAnd ctx w)),
     historyFile = Just historyFile,
     autoAddHistory = True
   }
 
-repl :: Context -> String -> InputT IO ()
-repl context readSoFar =
-  do let prompt = strWithColor Yellow (if null readSoFar then projectPrompt (contextProj context) else "     ")
+specialCommands :: Map.Map Char String
+specialCommands = Map.fromList
+  [ ('x', "run")
+  , ('r', "reload")
+  , ('b', "build")
+  , ('c', "cat")
+  , ('e', "env")
+  , ('h', "help")
+  , ('p', "project")
+  , ('q', "quit")
+  , ('t', "type")
+  , ('m', "expand")
+  , ('i', "info")
+  ]
+
+rewriteError :: String -> String
+rewriteError msg = "(macro-error \"" ++ msg ++ "\")"
+
+treatSpecialInput :: String -> String
+treatSpecialInput ":\n" = rewriteError "Unfinished special command"
+treatSpecialInput (':':rest) =
+  let cmdAndArgs = words rest
+      cmd = head cmdAndArgs
+      args = tail cmdAndArgs
+  in if length cmd == 1
+     then makeCommand args (head cmd)
+     else
+       if null args
+       then "(do " ++ unwords (map (makeCommand []) cmd) ++ ")"
+       else rewriteError "Can’t have grouped special command with arguments"
+  where makeCommand args cmd =
+         case Map.lookup cmd specialCommands of
+           Just command -> "(" ++ command ++ " " ++ unwords args ++ ")"
+           Nothing -> rewriteError ("Unknown special command: :" ++ [cmd])
+treatSpecialInput arg = arg
+
+repl :: String -> InputT (StateT Context IO) ()
+repl readSoFar =
+  do context <- get
+     let prompt = strWithColor Yellow (if null readSoFar then projectPrompt (contextProj context) else "     ")
      input <- getInputLine prompt
      case input of
-        Nothing -> return ()
+        Nothing -> do
+          liftIO exitSuccess
+          return ()
         Just i -> do
           let concat = readSoFar ++ i ++ "\n"
           case balance concat of
             0 -> do let input' = if concat == "\n" then contextLastInput context else concat -- Entering an empty string repeats last input
-                    context' <- liftIO $ executeString True (resetAlreadyLoadedFiles context) input' "REPL"
-                    repl (context' { contextLastInput = input' }) ""
-            _ -> repl context concat
+                    context' <- liftIO $ executeString True True (resetAlreadyLoadedFiles context) (treatSpecialInput input') "REPL"
+                    put context'
+                    repl ""
+            _ -> repl concat
 
 resetAlreadyLoadedFiles context =
   let proj = contextProj context
       proj' = proj { projectAlreadyLoaded = [] }
   in  context { contextProj = proj' }
+
+runRepl context = do
+  historyFile <- configPath "history"
+  createDirectoryIfMissing True (takeDirectory historyFile)
+  runStateT (runInputT (readlineSettings historyFile) (repl "")) context

src/StartingEnv.hs

@@ -8,11 +8,13 @@ import Obj
 import Types
 import Template
 import ToTemplate
-import ArrayTemplates
+import qualified ArrayTemplates
+import qualified StaticArrayTemplates
 import Commands
 import Parsing
 import Eval
 import Concretize
+import Debug.Trace (trace)
 
 -- | These modules will be loaded in order before any other code is evaluated.
 coreModules :: String -> [String]
@@ -26,23 +28,38 @@ arrayModule = Env { envBindings = bindings
                   , envUseModules = []
                   , envMode = ExternalEnv
                   , envFunctionNestingLevel = 0 }
-  where bindings = Map.fromList [ templateNth
-                                , templateAllocate
-                                , templateEMap
-                                , templateEFilter
-                                , templateRaw
-                                , templateUnsafeRaw
-                                , templateAset
-                                , templateAsetBang
-                                , templateAsetUninitializedBang
-                                , templateLength
-                                , templatePushBack
-                                , templatePushBackBang
-                                , templatePopBack
-                                , templatePopBackBang
-                                , templateDeleteArray
-                                , templateCopyArray
-                                , templateStrArray
+  where bindings = Map.fromList [ ArrayTemplates.templateNth
+                                , ArrayTemplates.templateAllocate
+                                , ArrayTemplates.templateEMap
+                                , ArrayTemplates.templateEFilter
+                                , ArrayTemplates.templateRaw
+                                , ArrayTemplates.templateUnsafeRaw
+                                , ArrayTemplates.templateAset
+                                , ArrayTemplates.templateAsetBang
+                                , ArrayTemplates.templateAsetUninitializedBang
+                                , ArrayTemplates.templateLength
+                                , ArrayTemplates.templatePushBack
+                                , ArrayTemplates.templatePushBackBang
+                                , ArrayTemplates.templatePopBack
+                                , ArrayTemplates.templatePopBackBang
+                                , ArrayTemplates.templateDeleteArray
+                                , ArrayTemplates.templateCopyArray
+                                , ArrayTemplates.templateStrArray
+                                ]
+
+-- | The static array module
+staticArrayModule :: Env
+staticArrayModule = Env { envBindings = bindings
+                        , envParent = Nothing
+                        , envModuleName = Just "StaticArray"
+                        , envUseModules = []
+                        , envMode = ExternalEnv
+                        , envFunctionNestingLevel = 0 }
+  where bindings = Map.fromList [ StaticArrayTemplates.templateUnsafeNth
+                                , StaticArrayTemplates.templateLength
+                                , StaticArrayTemplates.templateDeleteArray
+                                , StaticArrayTemplates.templateAsetBang
+                                , StaticArrayTemplates.templateStrArray
                                 ]
 
 -- | The Pointer module contains functions for dealing with pointers.
@@ -56,6 +73,7 @@ pointerModule = Env { envBindings = bindings
   where bindings = Map.fromList [ templatePointerCopy
                                 , templatePointerEqual
                                 , templatePointerToRef
+                                , templatePointerToValue
                                 , templatePointerAdd
                                 , templatePointerSub
                                 , templatePointerWidth
@@ -96,11 +114,23 @@ templatePointerToRef = defineTemplate
                         ,"}"])
   (const [])
 
+
+-- | A template function for converting pointers to values (it's up to the user of this function to make sure that is a safe operation).
+templatePointerToValue = defineTemplate
+  (SymPath ["Pointer"] "to-value")
+  (FuncTy [PointerTy (VarTy "p")] (VarTy "p") StaticLifetimeTy)
+  "converts a pointer to a value. The user will have to ensure themselves that this is a safe operation."
+  (toTemplate "$p $NAME ($p *p)")
+  (toTemplate $ unlines ["$DECL {"
+                        ,"    return *p;"
+                        ,"}"])
+  (const [])
+
 templatePointerAdd = defineTemplate
   (SymPath ["Pointer"] "add")
   (FuncTy [PointerTy (VarTy "p"), LongTy] (PointerTy (VarTy "p")) StaticLifetimeTy)
   "adds a long integer value to a pointer."
-  (toTemplate "$p* $NAME ($p *p, long x)")
+  (toTemplate "$p* $NAME ($p *p, Long x)")
   (toTemplate $ unlines ["$DECL {"
                         ,"    return p + x;"
                         ,"}"])
@@ -110,7 +140,7 @@ templatePointerSub = defineTemplate
   (SymPath ["Pointer"] "sub")
   (FuncTy [PointerTy (VarTy "p"), LongTy] (PointerTy (VarTy "p")) StaticLifetimeTy)
   "subtracts a long integer value from a pointer."
-  (toTemplate "$p* $NAME ($p *p, long x)")
+  (toTemplate "$p* $NAME ($p *p, Long x)")
   (toTemplate $ unlines ["$DECL {"
                         ,"    return p - x;"
                         ,"}"])
@@ -120,7 +150,7 @@ templatePointerWidth = defineTemplate
   (SymPath ["Pointer"] "width")
   (FuncTy [PointerTy (VarTy "p")] LongTy StaticLifetimeTy)
   "gets the byte size of a pointer."
-  (toTemplate "long $NAME ($p *p)")
+  (toTemplate "Long $NAME ($p *p)")
   (toTemplate $ unlines ["$DECL {"
                         ,"    return sizeof(*p);"
                         ,"}"])
@@ -130,9 +160,9 @@ templatePointerToLong = defineTemplate
   (SymPath ["Pointer"] "to-long")
   (FuncTy [PointerTy (VarTy "p")] LongTy StaticLifetimeTy)
   "converts a pointer to a long integer."
-  (toTemplate "long $NAME ($p *p)")
+  (toTemplate "Long $NAME ($p *p)")
   (toTemplate $ unlines ["$DECL {"
-                        ,"    return (long)p;"
+                        ,"    return (Long)p;"
                         ,"}"])
   (const [])
 
@@ -140,7 +170,7 @@ templatePointerFromLong = defineTemplate
   (SymPath ["Pointer"] "from-long")
   (FuncTy [LongTy] (PointerTy (VarTy "p")) StaticLifetimeTy)
   "converts a long integer to a pointer."
-  (toTemplate "$p* $NAME (long p)")
+  (toTemplate "$p* $NAME (Long p)")
   (toTemplate $ unlines ["$DECL {"
                         ,"    return ($p*)p;"
                         ,"}"])
@@ -373,7 +403,7 @@ unsafeModule = Env { envBindings = bindings
                    , envUseModules = []
                    , envMode = ExternalEnv
                    , envFunctionNestingLevel = 0 }
-  where bindings = Map.fromList [ templateCoerce ]
+  where bindings = Map.fromList [ templateCoerce, templateLeak ]
 
 -- | A template for coercing (casting) a type to another type
 templateCoerce :: (String, Binder)
@@ -387,6 +417,17 @@ templateCoerce = defineTemplate
                         ,"}"])
   (const [])
 
+-- | A template function for preventing destructor from being run on a value (it's up to the user of this function to make sure that memory is freed).
+templateLeak = defineTemplate
+  (SymPath ["Unsafe"] "leak")
+  (FuncTy [(VarTy "a")] UnitTy StaticLifetimeTy)
+  "prevents a destructor from being run on a value a."
+  (toTemplate "void $NAME ($a a)")
+  (toTemplate $ unlines ["$DECL {"
+                        ,"    // Leak"
+                        ,"}"])
+  (const [])
+
 -- | The global environment before any code is run.
 startingGlobalEnv :: Bool -> Env
 startingGlobalEnv noArray =
@@ -401,11 +442,12 @@ startingGlobalEnv noArray =
                                   , templateEnumToInt
                                   ]
                    ++ (if noArray then [] else [("Array", Binder emptyMeta (XObj (Mod arrayModule) Nothing Nothing))])
+                   ++ [("StaticArray", Binder emptyMeta (XObj (Mod staticArrayModule) Nothing Nothing))]
                    ++ [("Pointer",  Binder emptyMeta (XObj (Mod pointerModule) Nothing Nothing))]
                    ++ [("System",   Binder emptyMeta (XObj (Mod systemModule) Nothing Nothing))]
                    ++ [("Dynamic",  Binder emptyMeta (XObj (Mod dynamicModule) Nothing Nothing))]
                    ++ [("Function", Binder emptyMeta (XObj (Mod functionModule) Nothing Nothing))]
-                   ++ [("Unsafe", Binder emptyMeta (XObj (Mod unsafeModule) Nothing Nothing))]
+                   ++ [("Unsafe",   Binder emptyMeta (XObj (Mod unsafeModule) Nothing Nothing))]
 
 -- | The type environment (containing deftypes and interfaces) before any code is run.
 startingTypeEnv :: Env
@@ -422,11 +464,11 @@ startingTypeEnv = Env { envBindings = bindings
             builtInSymbolInfo
 
           , interfaceBinder "str" (FuncTy [VarTy "a"] StringTy StaticLifetimeTy)
-            (SymPath ["Array"] "str" : registerFunctionFunctionsWithInterface "str")
+            ((SymPath ["Array"] "str") : (SymPath ["StaticArray"] "str") : registerFunctionFunctionsWithInterface "str")
             builtInSymbolInfo
 
           , interfaceBinder "prn" (FuncTy [VarTy "a"] StringTy StaticLifetimeTy)
-            (registerFunctionFunctionsWithInterface "prn")
+            ((SymPath ["StaticArray"] "str") : (registerFunctionFunctionsWithInterface "prn")) -- QUESTION: Where is 'prn' for dynamic Array:s registered? Can't find it... (but it is)
             builtInSymbolInfo
           ]
         builtInSymbolInfo = Info (-1) (-1) "Built-in." Set.empty (-1)

src/StaticArrayTemplates.hs

@@ -0,0 +1,115 @@
+module StaticArrayTemplates where
+
+import Util
+import Types
+import Obj
+import Parsing
+import Template
+import ToTemplate
+import Polymorphism
+import Concretize
+import Lookup
+import qualified ArrayTemplates
+
+
+
+-- | NOTE: The code for these templates is copied from ArrayTemplates.hs but
+-- since there are some small differences here and there I'v decided to not
+-- try to abstract over them and just duplicate the templates instead.
+
+
+
+templateUnsafeNth :: (String, Binder)
+templateUnsafeNth =
+  let t = VarTy "t"
+  in defineTemplate
+  (SymPath ["StaticArray"] "unsafe-nth")
+  (FuncTy [RefTy (StructTy "StaticArray" [t]) (VarTy "q"), IntTy] (RefTy t (VarTy "q")) StaticLifetimeTy)
+  "gets a reference to the `n`th element from a static array `a`."
+  (toTemplate "$t* $NAME (Array *aRef, int n)")
+  (toTemplate $ unlines ["$DECL {"
+                        ,"    Array a = *aRef;"
+                        ,"    assert(n >= 0);"
+                        ,"    assert(n < a.len);"
+                        ,"    return &((($t*)a.data)[n]);"
+                        ,"}"])
+  (\(FuncTy [RefTy arrayType _, _] _ _) ->
+     [])
+
+templateLength :: (String, Binder)
+templateLength = defineTypeParameterizedTemplate templateCreator path t docs
+  where path = SymPath ["StaticArray"] "length"
+        t = FuncTy [RefTy (StructTy "StaticArray" [VarTy "t"]) (VarTy "q")] IntTy StaticLifetimeTy
+        docs = "gets the length of the static array."
+        templateCreator = TemplateCreator $
+          \typeEnv env ->
+            Template
+            t
+            (const (toTemplate "int $NAME (Array *a)"))
+            (const (toTemplate "$DECL { return (*a).len; }"))
+            (\(FuncTy [RefTy arrayType _] _ _) ->
+              depsForDeleteFunc typeEnv env arrayType)
+
+templateDeleteArray :: (String, Binder)
+templateDeleteArray = defineTypeParameterizedTemplate templateCreator path t docs
+  where path = SymPath ["StaticArray"] "delete"
+        t = FuncTy [StructTy "StaticArray" [VarTy "a"]] UnitTy StaticLifetimeTy
+        docs = "deletes a static array. This function should not be called manually (there shouldn't be a way to create value types of type StaticArray)."
+        templateCreator = TemplateCreator $
+          \typeEnv env ->
+             Template
+             t
+             (const (toTemplate "void $NAME (Array a)"))
+             (\(FuncTy [arrayType] UnitTy _) ->
+                [TokDecl, TokC "{\n"] ++
+                deleteTy typeEnv env arrayType ++
+                [TokC "}\n"])
+             (\(FuncTy [arrayType@(StructTy "StaticArray" [insideType])] UnitTy _) ->
+                depsForDeleteFunc typeEnv env insideType)
+
+deleteTy :: TypeEnv -> Env -> Ty -> [Token]
+deleteTy typeEnv env (StructTy _ [innerType]) =
+  [ TokC   "    for(int i = 0; i < a.len; i++) {\n"
+  , TokC $ "    " ++ ArrayTemplates.insideArrayDeletion typeEnv env innerType "i"
+  , TokC   "    }\n"
+  ]
+deleteTy _ _ _ = []
+
+templateAsetBang :: (String, Binder)
+templateAsetBang = defineTypeParameterizedTemplate templateCreator path t docs
+  where path = SymPath ["StaticArray"] "aset!"
+        t = FuncTy [RefTy (StructTy "StaticArray" [VarTy "t"]) (VarTy "q"), IntTy, VarTy "t"] UnitTy StaticLifetimeTy
+        docs = "sets a static array element at the index `n` to a new value in place."
+        templateCreator = TemplateCreator $
+          \typeEnv env ->
+            Template
+            t
+            (const (toTemplate "void $NAME (Array *aRef, int n, $t newValue)"))
+            (\(FuncTy [_, _, insideTy] _ _) ->
+               let deleter = ArrayTemplates.insideArrayDeletion typeEnv env insideTy
+               in  (toTemplate $ unlines ["$DECL {"
+                                         ,"    Array a = *aRef;"
+                                         ,"    assert(n >= 0);"
+                                         ,"    assert(n < a.len);"
+                                         ,     deleter "n"
+                                         ,"    (($t*)a.data)[n] = newValue;"
+                                         ,"}"]))
+            (\(FuncTy [RefTy arrayType _, _, _] _ _) ->
+               depsForDeleteFunc typeEnv env arrayType)
+
+templateStrArray :: (String, Binder)
+templateStrArray = defineTypeParameterizedTemplate templateCreator path t docs
+  where templateCreator = TemplateCreator $
+          \typeEnv env ->
+             Template
+             t
+             (const (toTemplate "String $NAME (Array* a)"))
+             (\(FuncTy [RefTy arrayType _] StringTy _) ->
+                [TokDecl, TokC " {\n"] ++
+                ArrayTemplates.strTy typeEnv env arrayType ++
+                [TokC "}\n"])
+             (\(FuncTy [RefTy arrayType@(StructTy "StaticArray" [insideType]) _] StringTy _) ->
+                depsForPrnFunc typeEnv env insideType)
+        path = SymPath ["StaticArray"] "str"
+        t = FuncTy [RefTy (StructTy "StaticArray" [VarTy "a"]) (VarTy "q")] StringTy StaticLifetimeTy
+        docs = "converts a static array to a string."

src/Sumtypes.hs

@@ -73,7 +73,7 @@ concreteCaseInit allocationMode insidePath structTy sumtypeCase =
                  correctedTys = map (replaceTyVars mappings) (caseTys sumtypeCase)
              in  (toTemplate $ "$p $NAME(" ++ joinWithComma (zipWith (curry memberArg) anonMemberNames correctedTys) ++ ")"))
           (const (tokensForCaseInit allocationMode structTy sumtypeCase))
-          (\(FuncTy _ _ _) -> [])
+          (\FuncTy{} -> [])
 
 genericCaseInit :: AllocationMode -> [String] -> Ty -> SumtypeCase -> (String, Binder)
 genericCaseInit allocationMode pathStrings originalStructTy sumtypeCase =

src/TypeError.hs

@@ -154,9 +154,11 @@ instance Show TypeError where
     "I found the following holes:\n\n    " ++
     joinWith "\n    " (map (\(name, t) -> name ++ " : " ++ show t) holes) ++
     "\n"
-  show (FailedToExpand xobj err@EvalError{}) =
+  show (FailedToExpand xobj err@(EvalError _ hist _ _)) =
     "I failed to expand a macro at " ++ prettyInfoFromXObj xobj ++
-    ".\n\nThe error message I got was: " ++ show err
+    ".\n\nThe error message I got was: " ++ show err ++
+    "\nTraceback:\n" ++
+    unlines (map (prettyUpTo 60) hist)
   show (NotAValidType xobj) =
     pretty xobj ++ "is not a valid type at " ++ prettyInfoFromXObj xobj
   show (FunctionsCantReturnRefTy xobj t) =
@@ -294,7 +296,7 @@ machineReadableErrorStrings fppl err =
     -- (HolesFound holes) ->
     --   (map (\(name, t) -> machineReadableInfoFromXObj fppl xobj ++ " " ++ name ++ " : " ++ show t) holes)
 
-    (FailedToExpand xobj (EvalError errorMessage _ _)) ->
+    (FailedToExpand xobj (EvalError errorMessage _ _ _)) ->
       [machineReadableInfoFromXObj fppl xobj ++ "Failed to expand: " ++ errorMessage]
 
     -- TODO: Remove overlapping errors:
@@ -382,10 +384,14 @@ showTypeFromXObj mappings xobj =
     Just t -> show (recursiveLookupTy mappings t)
     Nothing -> "Type missing"
 
+evalError :: Context -> String -> Maybe Info -> (Context, Either EvalError a)
+evalError ctx msg i = makeEvalError ctx Nothing msg i
+
 -- | Print type errors correctly when running the compiler in 'Check' mode
-makeEvalError :: Context -> Maybe TypeError.TypeError -> String -> Maybe Info -> Either EvalError a
+makeEvalError :: Context -> Maybe TypeError.TypeError -> String -> Maybe Info -> (Context, Either EvalError a)
 makeEvalError ctx err msg info =
   let fppl = projectFilePathPrintLength (contextProj ctx)
+      history = contextHistory ctx
   in case contextExecMode ctx of
        Check -> let messageWhenChecking = case err of
                                             Just okErr -> joinedMachineReadableErrorStrings fppl okErr
@@ -393,5 +399,5 @@ makeEvalError ctx err msg info =
                                               case info of
                                                 Just okInfo -> machineReadableInfo fppl okInfo ++ " " ++ msg
                                                 Nothing -> msg
-                in  Left (EvalError messageWhenChecking Nothing fppl) -- Passing no info to avoid appending it at the end in 'show' instance for EvalError
-       _ ->  Left (EvalError msg info fppl)
+                in  (ctx, Left (EvalError messageWhenChecking [] fppl Nothing)) -- Passing no history to avoid appending it at the end in 'show' instance for EvalError
+       _ ->  (ctx, Left (EvalError msg history fppl info))

src/Types.hs

@@ -109,14 +109,14 @@ tyToC :: Ty -> String
 tyToC = tyToCManglePtr False
 
 tyToCLambdaFix :: Ty -> String
-tyToCLambdaFix t@(FuncTy _ _ _) = "Lambda"
-tyToCLambdaFix (RefTy (FuncTy _ _ _) _) = "Lambda*"
-tyToCLambdaFix (RefTy (RefTy (FuncTy _ _ _) _) _) = "Lambda**"
-tyToCLambdaFix (RefTy (RefTy (RefTy (FuncTy _ _ _) _) _) _) = "Lambda***" -- | TODO: More cases needed?! What's a better way to do it..?
+tyToCLambdaFix t@FuncTy{} = "Lambda"
+tyToCLambdaFix (RefTy FuncTy{} _) = "Lambda*"
+tyToCLambdaFix (RefTy (RefTy FuncTy{} _) _) = "Lambda**"
+tyToCLambdaFix (RefTy (RefTy (RefTy FuncTy{} _) _) _) = "Lambda***" -- | TODO: More cases needed?! What's a better way to do it..?
 tyToCLambdaFix t = tyToCManglePtr False t
 
 tyToCRawFunctionPtrFix :: Ty -> String
-tyToCRawFunctionPtrFix t@(FuncTy _ _ _) = "void*"
+tyToCRawFunctionPtrFix t@FuncTy{} = "void*"
 tyToCRawFunctionPtrFix t = tyToCManglePtr False t
 
 tyToCManglePtr :: Bool -> Ty -> String
@@ -124,7 +124,7 @@ tyToCManglePtr _ IntTy                   = "int"
 tyToCManglePtr _ BoolTy                  = "bool"
 tyToCManglePtr _ FloatTy                 = "float"
 tyToCManglePtr _ DoubleTy                = "double"
-tyToCManglePtr _ LongTy                  = "long"
+tyToCManglePtr _ LongTy                  = "Long"
 tyToCManglePtr _ ByteTy                  = "uint8_t"
 tyToCManglePtr _ StringTy                = "String"
 tyToCManglePtr _ PatternTy               = "Pattern"
@@ -251,7 +251,7 @@ unifySignatures v t = Map.fromList (unify v t)
               retToks = unify retTyA retTyB
               ltToks = unify ltA ltB
           in  ltToks ++ argToks ++ retToks
-        unify a@(FuncTy _ _ _) b = [] -- error ("Can't unify " ++ show a ++ " with " ++ show b)
+        unify a@FuncTy{} b = [] -- error ("Can't unify " ++ show a ++ " with " ++ show b)
         unify a b | a == b    = []
                   | otherwise = [] -- error ("Can't unify " ++ show a ++ " with " ++ show b)
 
@@ -269,14 +269,14 @@ areUnifiable (StructTy _ _) _ = False
 areUnifiable (PointerTy a) (PointerTy b) = areUnifiable a b
 areUnifiable (PointerTy _) _ = False
 areUnifiable (RefTy a ltA) (RefTy b ltB) = areUnifiable a b && areUnifiable ltA ltB
-areUnifiable (RefTy _ _) _ = False
+areUnifiable RefTy{} _ = False
 areUnifiable (FuncTy argTysA retTyA ltA) (FuncTy argTysB retTyB ltB)
   | length argTysA /= length argTysB = False
   | otherwise = let argBools = zipWith areUnifiable argTysA argTysB
                     retBool = areUnifiable retTyA retTyB
                     ltBool = areUnifiable ltA ltB
                 in  all (== True) (ltBool : retBool : argBools)
-areUnifiable (FuncTy _ _ _) _ = False
+areUnifiable FuncTy{} _ = False
 areUnifiable a b | a == b    = True
           | otherwise = False
 

src/Validate.hs

@@ -44,7 +44,7 @@ canBeUsedAsMemberType typeEnv typeVariables t xobj =
     StringTy  -> return ()
     PatternTy -> return ()
     CharTy    -> return ()
-    FuncTy _ _ _ -> return ()
+    FuncTy{} -> return ()
     PointerTy inner -> do _ <- canBeUsedAsMemberType typeEnv typeVariables inner xobj
                           return ()
     StructTy "Array" [inner] -> do _ <- canBeUsedAsMemberType typeEnv typeVariables inner xobj

test/Spec.hs

@@ -43,7 +43,8 @@ testConstraints = [testConstr1, testConstr2, testConstr3, testConstr4, testConst
                   ,testConstr6, testConstr7, testConstr8, testConstr9, testConstr10
                   ,testConstr11, testConstr12, testConstr13
                   ,testConstr20, testConstr21, testConstr22, testConstr23, testConstr24
-                  ,testConstr30, testConstr31, testConstr32, testConstr33
+                  -- ,testConstr30 DISABLED FOR NOW, started failing when lifetimes were added to function types TODO: Fix!
+                  ,testConstr31, testConstr32, testConstr33
                   ,testConstr34, testConstr35
                   ]
 
@@ -143,23 +144,23 @@ testConstr24 = assertUnificationFailure
 
 -- Func types
 testConstr30 = assertSolution
-  [Constraint t2 (FuncTy [t0] t1) x x x OrdNo
-  ,Constraint t2 (FuncTy [IntTy] BoolTy) x x x OrdNo]
-  [("t0", IntTy), ("t1", BoolTy), ("t2", (FuncTy [IntTy] BoolTy))]
+  [Constraint t2 (FuncTy [t0] t1 StaticLifetimeTy) x x x OrdNo
+  ,Constraint t2 (FuncTy [IntTy] BoolTy StaticLifetimeTy) x x x OrdNo]
+  [("t0", IntTy), ("t1", BoolTy), ("t2", (FuncTy [IntTy] BoolTy StaticLifetimeTy))]
 
 testConstr31 = assertSolution
-  [Constraint (FuncTy [t0] t1) (FuncTy [IntTy] BoolTy) x x x OrdNo]
+  [Constraint (FuncTy [t0] t1 StaticLifetimeTy) (FuncTy [IntTy] BoolTy StaticLifetimeTy) x x x OrdNo]
   [("t0", IntTy), ("t1", BoolTy)]
 
 testConstr32 = assertSolution
-  [Constraint t0 (FuncTy [IntTy] BoolTy) x x x OrdNo]
-  [("t0", (FuncTy [IntTy] BoolTy))]
+  [Constraint t0 (FuncTy [IntTy] BoolTy StaticLifetimeTy) x x x OrdNo]
+  [("t0", (FuncTy [IntTy] BoolTy StaticLifetimeTy))]
 
 testConstr33 = assertSolution
-  [Constraint t1 (FuncTy [t2] IntTy) x x x OrdNo
-  ,Constraint t1 (FuncTy [t3] IntTy) x x x OrdNo
+  [Constraint t1 (FuncTy [t2] IntTy StaticLifetimeTy) x x x OrdNo
+  ,Constraint t1 (FuncTy [t3] IntTy StaticLifetimeTy) x x x OrdNo
   ,Constraint t3 BoolTy x x x OrdNo]
-  [("t1", (FuncTy [BoolTy] IntTy))
+  [("t1", (FuncTy [BoolTy] IntTy StaticLifetimeTy))
   ,("t2", BoolTy)
   ,("t3", BoolTy)]
 

test/args.carp

@@ -2,7 +2,10 @@
 (use Test)
 
 (defndynamic _make-exe-path [pth]
-  (String.join (array (Project.get-config "output-directory") pth)))
+  (let [out (Project.get-config "output-directory")
+        sep (if (Dynamic.or (= (os) "windows") (= (os) "mingw32")) "\\" "/")
+        lst (String.suffix out (- (String.length out) 1))]
+    (String.join (array out (if (= lst sep) "" sep) pth))))
 
 (defmacro make-exe-path [pth]
   (_make-exe-path pth))

test/int16.carp

@@ -1,7 +1,7 @@
 (load "Test.carp")
 (use Test)
 
-(load "stdint.carp")
+(load "StdInt.carp")
 (use Int16)
 
 (deftest test

test/int32.carp

@@ -1,7 +1,7 @@
 (load "Test.carp")
 (use Test)
 
-(load "stdint.carp")
+(load "StdInt.carp")
 (use Int32)
 
 (deftest test

test/int64.carp

@@ -1,7 +1,7 @@
 (load "Test.carp")
 (use Test)
 
-(load "stdint.carp")
+(load "StdInt.carp")
 (use Int64)
 
 (deftest test

test/int8.carp

@@ -1,7 +1,7 @@
 (load "Test.carp")
 (use Test)
 
-(load "stdint.carp")
+(load "StdInt.carp")
 (use Int8)
 
 (deftest test

test/macros.carp

@@ -50,10 +50,64 @@
 (defmacro test-gensym []
   (let [x (gensym)]
     (list 'let (array x 1) (list '= x 1))))
+
+(defmacro test-read-file []
+  (read-file "test/fixture_file.txt"))
+
 (defmacro test-gensym-with []
   (let [x (gensym-with 'a)]
     (list 'let (array x 1) (list '= x 1))))
 
+(defmacro test-map []
+  (let [mapped (Dynamic.map length '((a) (b c) (d e f)))]
+    (Dynamic.and (Dynamic.and (= 1 (Dynamic.car mapped)) (= 2 (Dynamic.cadr mapped))) (= 3
+    (Dynamic.caddr mapped)))))
+
+(defmacro test-zip []
+  (let [zipped (Dynamic.zip array '('a 'd) '('c 'o) '('e 'g))]
+    (Dynamic.and (= 'ace (Symbol.join (eval (Dynamic.car zipped))))
+      (= 'dog (Symbol.join (eval (Dynamic.cadr zipped)))))))
+
+(defmacro test-curry []
+  (= 3 ((Dynamic.curry + 1) 2)))
+
+(defmacro test-flip []
+  (= 'Foo.Bar ((Dynamic.flip Symbol.prefix) 'Bar 'Foo)))
+
+(defmacro test-compose []
+  (= '() ((Dynamic.compose Dynamic.empty Dynamic.take) 2 '(1 2 3 4))))
+
+(defmacro test-reduce []
+  (= 10 (Dynamic.reduce + 0 '(1 2 3 4))))
+
+(defmacro test-unreduce []
+  (Dynamic.reduce Dynamic.and-internal true
+    (Dynamic.map 'eval
+      (Dynamic.zip = '(1 2 3 4) (Dynamic.unreduce (curry + 1) 0 4 (list))))))
+
+(defmacro test-filter []
+  (Dynamic.reduce Dynamic.and-internal true
+    (Dynamic.map 'eval
+      (Dynamic.zip = '('a 'a 'a 'a)
+        (Dynamic.map Dynamic.quoted
+	  (Dynamic.filter (fn [x] (= 'a x)) '(a b a b a b a b)))))))
+
+(defmacro test-empty []
+  ;; We can't compare '[] and '[] for some reason.
+  ;; But '() and '() are comparable
+  (Dynamic.and (= '() (Dynamic.empty '(1 2 3 4)))
+               (empty? (Dynamic.empty '[1 2 3 4]))))
+
+(defmacro test-reverse []
+  (Dynamic.reduce Dynamic.and-internal true
+    (Dynamic.map 'eval
+      (Dynamic.zip = '(4 3 2 1) (Dynamic.reverse '(1 2 3 4))))))
+
+(defmacro test-take []
+  (let [result  (Dynamic.take 2 '(1 2 3 4))]
+    (Dynamic.and (= 1 (car result ))
+                 (= '() (cddr result)))))
+
 (deftest test
   (assert-true test
                (test-let-do)
@@ -209,7 +263,7 @@
                 "Symbol.join works as expected")
   (assert-equal test
                 "test file contents\n"
-                (Dynamic.read-file "test/fixture_file.txt")
+                (test-read-file)
                 "Dynamic.read-file works as expected")
   (assert-true test
                (test-gensym-with)
@@ -217,4 +271,37 @@
   (assert-true test
                (test-gensym)
                "gensym works as expected")
+  (assert-true test
+               (test-map)
+               "map works as expected")
+  (assert-true test
+               (test-zip)
+               "zip works as expected")
+  (assert-true test
+               (test-curry)
+               "curry works as expected")
+  (assert-true test
+               (test-flip)
+               "filp works as expected")
+  (assert-true test
+               (test-compose)
+               "compose works as expected")
+  (assert-true test
+               (test-reduce)
+               "reduce works as expected")
+  (assert-true test
+               (test-unreduce)
+               "unreduce works as expected")
+  (assert-true test
+               (test-filter)
+               "filter works as expected")
+  (assert-true test
+               (test-reverse)
+               "reverse works as expected")
+  (assert-true test
+               (test-empty)
+               "empty works as expected")
+  (assert-true test
+               (test-take)
+               "take works as expected")
 )

test/output/test-for-errors/char_at_index.carp.output.expected

@@ -1 +1 @@
-Can't call char-at with "" and 1, index too large at char_at_index.carp:2:17.
+char_at_index.carp:2:17 Can't call char-at with "" and 1, index too large

test/pointer.carp

@@ -7,6 +7,9 @@
 (def xa (to-long x))
 (def w (width x))
 
+(defn ref-to-ptr [r]
+  (the (Ptr a) (Unsafe.coerce (the (Ref a) r))))
+
 ; these tests are sadly a little unsafe
 (deftest test
   (assert-equal test
@@ -35,4 +38,9 @@
                 (to-long (dec x))
                 "Pointer.dec works as expected"
   )
+  (assert-equal test
+                (to-value (ref-to-ptr &123))
+                123
+                "Pointer.to-value works as expected"
+  )
 )

test/safe_arithmetic.carp

@@ -1,3 +1,6 @@
+(windows-only ; safe arithmetic does not currently work on windows
+  (quit))
+
 (load "Test.carp")
 (load "SafeInt.carp")
 

test/static_array.carp

@@ -0,0 +1,35 @@
+(use StaticArray)
+
+(load "Test.carp")
+(use Test)
+
+(deftest test
+
+  (assert-true test
+               (= $[1 2 3] $[1 2 3])
+               "= works as expected I")
+
+  (assert-false test
+                (= $[1 2 3] $[1 2 3 4 5])
+                "= works as expected II")
+
+  (assert-false test
+                (= $[1 1 1] $[0 0 0])
+                "= works as expected III")
+
+  (assert-equal test
+                5
+                (let [a $[0 1 2 3 4 5 6 7 8 9]]
+                  @(unsafe-nth a 5))
+                "unsafe-nth works as expected")
+
+  ;; TODO: FIX! THIS ONE IS PROBLEMATIC.
+  ;; (assert-equal test
+  ;;               &[4 5 6]
+  ;;               (let [nested $[[1 2 3]
+  ;;                              [4 5 6]
+  ;;                              [7 8 9]]]
+  ;;                 &@(unsafe-nth nested 1))
+  ;;               "unsafe-nth works as expected")
+
+  )

test/uint16.carp

@@ -1,7 +1,7 @@
 (load "Test.carp")
 (use Test)
 
-(load "stdint.carp")
+(load "StdInt.carp")
 (use Uint16)
 
 (deftest test

test/uint32.carp

@@ -1,7 +1,7 @@
 (load "Test.carp")
 (use Test)
 
-(load "stdint.carp")
+(load "StdInt.carp")
 (use Uint32)
 
 (deftest test