diff --git a/core/Array.carp b/core/Array.carp index 98e9a2332..ca7b7d92a 100644 --- a/core/Array.carp +++ b/core/Array.carp @@ -32,7 +32,7 @@ As an example, consider this definition of `sum` based on `reduce`: ``` (defn sum [x] - (reduce &(fn [x y] (+ x @y)) 0 x)) + (reduce (fn [x y] (+ x @y)) 0 x)) ``` It will sum the previous sum with each new value, starting at `0`.") @@ -188,7 +188,7 @@ If the array is empty, returns `Nothing`") (doc sum "sums an array (elements must support `+` and `zero`).") (defn sum [xs] - (Array.reduce &(fn [x y] (+ x @y)) (zero) xs)) + (Array.reduce (fn [x y] (+ x @y)) (zero) xs)) (doc slice "gets a subarray from `start-index` to `end-index`.") (defn slice [xs start-index end-index] @@ -313,7 +313,7 @@ Example: ``` ; if we didn’t have Array.range, we could define it like this: (defn range [start end step] - (unreduce start &(fn [x] (< x (+ step end))) &(fn [x] (+ x step))) + (unreduce start (fn [x] (< x (+ step end))) &(fn [x] (+ x step))) ) ```") (defn unreduce [start test step] @@ -383,7 +383,7 @@ If the `index` is out of bounds, return `Maybe.Nothing`") (doc remove "removes all occurrences of the element `el` in the array `arr`, in place.") (defn remove [el arr] - (endo-filter &(fn [x] (not (= el x))) + (endo-filter (fn [x] (not (= el x))) arr)) (doc remove-nth "removes element at index `idx` from the array `arr`.") @@ -463,12 +463,12 @@ the second one is the element. `f` must return `(Pair accumulator result)`. Example: ``` -(map-reduce &(fn [acc x] (Pair.init (+ @x @acc) (* @x 2))) 0 &[1 2 3]) +(map-reduce (fn [acc x] (Pair.init (+ @x @acc) (* @x 2))) 0 &[1 2 3]) ; => (Pair 6 [2 4 6]) ```") (defn map-reduce [f acc a] (reduce - &(fn [a el] + (fn [a el] (let [l (Pair.b &a) acc (Pair.a &a) p (~f acc el)] diff --git a/core/Binary.carp b/core/Binary.carp index d64b928af..b3060c9a7 100644 --- a/core/Binary.carp +++ b/core/Binary.carp @@ -52,10 +52,11 @@ If the conversion fails, returns a `Result.Error` containing the byte array passed as an argument.") (defn byte-converter [f order] - (fn [bs] + @(fn [bs] (match (~f order bs) (Maybe.Nothing) (Result.Error @bs) (Maybe.Just i) (Result.Success i)))) + (doc interpreted "Returns the interpreted value from a sequence of byte-converion results") (private interpreted) @@ -76,7 +77,7 @@ (ref) (Array.copy-map &Array.length) (ref) - (Array.reduce &(fn [x y] (+ x @y)) 0))) + (Array.reduce (fn [x y] (+ x @y)) 0))) (doc system-endianness "Returns the endianness of the host system.") @@ -127,7 +128,7 @@ (defn unsafe-bytes->int16-seq [order bs] (let [partitions (Array.partition bs 2) f (fn [b] (unsafe-bytes->int16 order b))] - (Array.copy-map &f &partitions))) + (Array.copy-map f &partitions))) (doc bytes->int16-seq "Interprets a sequence of bytes as a sequence of Uint16 values. @@ -156,7 +157,7 @@ (sig int16-seq->bytes (Fn [ByteOrder (Ref (Array Uint16) a)] (Array (Array Byte)))) (defn int16-seq->bytes [order is] (let [f (fn [i] (int16->bytes order @i))] - (Array.copy-map &f is))) + (Array.copy-map f is))) (doc unsafe-bytes->int32 "Interprets the first four bytes in a byte sequence as an Uint32 value. @@ -194,10 +195,10 @@ (match order (ByteOrder.LittleEndian) (Array.copy-map &int32-to-byte - &[i (shift 8l) (shift 16l) (shift 24l)]) + &[i (~shift 8l) (~shift 16l) (~shift 24l)]) (ByteOrder.BigEndian) (Array.copy-map &int32-to-byte - &[(shift 24l) (shift 16l) (shift 8l) i])))) + &[(~shift 24l) (~shift 16l) (~shift 8l) i])))) (doc unsafe-bytes->int32-seq "Interprets a sequence of bytes as a sequence of Uint32 values. @@ -206,7 +207,7 @@ (defn unsafe-bytes->int32-seq [order bs] (let [partitions (Array.partition bs 4) f (fn [b] (unsafe-bytes->int32 order b))] - (Array.copy-map &f &partitions))) + (Array.copy-map f &partitions))) (doc bytes->int32-seq "Interprets a sequence of bytes as a sequence of Uint32 values. @@ -235,7 +236,7 @@ (sig int32-seq->bytes (Fn [ByteOrder (Ref (Array Uint32) a)] (Array (Array Byte)))) (defn int32-seq->bytes [order is] (let [f (fn [i] (int32->bytes order @i))] - (Array.copy-map &f is))) + (Array.copy-map f is))) (doc unsafe-bytes->int64 "Interprets the first eight bytes in a byte sequence as an Uint64 value. @@ -280,14 +281,14 @@ (match order (ByteOrder.LittleEndian) (Array.copy-map &int64-to-byte - &[i (shift 8l) (shift 16l) - (shift 24l) (shift 32l) - (shift 40l) (shift 48l) (shift 56l)]) + &[i (~shift 8l) (~shift 16l) + (~shift 24l) (~shift 32l) + (~shift 40l) (~shift 48l) (~shift 56l)]) (ByteOrder.BigEndian) (Array.copy-map &int64-to-byte - &[(shift 56l) (shift 48l) - (shift 40l) (shift 32l) - (shift 24l) (shift 16l) (shift 8l) i])))) + &[(~shift 56l) (~shift 48l) + (~shift 40l) (~shift 32l) + (~shift 24l) (~shift 16l) (~shift 8l) i])))) (doc unsafe-bytes->int64-seq "Interprets a sequence of bytes as a sequence of Uint64 values. @@ -296,7 +297,7 @@ (defn unsafe-bytes->int64-seq [order bs] (let [partitions (Array.partition bs 8) f (fn [b] (unsafe-bytes->int64 order b))] - (Array.copy-map &f &partitions))) + (Array.copy-map f &partitions))) (doc bytes->int64-seq "Interprets a sequence of bytes as a sequence of Uint64 values. @@ -325,7 +326,7 @@ (sig int64-seq->bytes (Fn [ByteOrder (Ref (Array Uint64) a)] (Array (Array Byte)))) (defn int64-seq->bytes [order is] (let [f (fn [i] (int64->bytes order @i))] - (Array.copy-map &f is))) + (Array.copy-map f is))) (defn to-hex-str [b] (let [hi (Byte.bit-and b (from-int 0xF0)) @@ -373,5 +374,5 @@ (sig bytes->hex-string (Fn [(Ref (Array Byte) q)] String)) (defn bytes->hex-string [bs] (let [f (fn [b] (to-hex-str @b))] - (String.join " " &(Array.copy-map &f bs)))) + (String.join " " &(Array.copy-map f bs)))) ) diff --git a/core/Control.carp b/core/Control.carp index d4f96e3b2..abd947069 100644 --- a/core/Control.carp +++ b/core/Control.carp @@ -20,15 +20,15 @@ other higher order concepts.") (set! result (~f result))) result)) - (doc when-success + (doc when-success "Executes a side effect, `f`, when `result` is `Success`ful." "```" "(def suc (the (Result Int Int) (Result.Success 0)))" "(def err (the (Result Int Int) (Result.Error 0)))" "" - "(when-success &(fn [] (IO.println \"success!\")) suc)" + "(when-success (fn [] (IO.println \"success!\")) suc)" "=> success!" - "(when-success &(fn [] (IO.println \"success!\")) err)" + "(when-success (fn [] (IO.println \"success!\")) err)" "=> " "```") (sig when-success (Fn [&(Fn [] ()) (Result a b)] ())) @@ -37,15 +37,15 @@ other higher order concepts.") (Result.Success _) (~f) _ ())) - (doc when-error + (doc when-error "Executes a side effect, `f`, when `result` is `Error`oneus." "```" "(def suc (the (Result Int Int) (Result.Success 0)))" "(def err (the (Result Int Int) (Result.Error 0)))" "" - "(when-error &(fn [] (IO.println \"error!\")) err)" + "(when-error (fn [] (IO.println \"error!\")) err)" "=> error!" - "(when-error &(fn [] (IO.println \"error!\")) suc)" + "(when-error (fn [] (IO.println \"error!\")) suc)" "=> " "```") (sig when-error (Fn [&(Fn [] ()) (Result a b)] ())) @@ -54,15 +54,15 @@ other higher order concepts.") (Result.Error _) (~f) _ ())) - (doc when-just + (doc when-just "Executes a side-effect, `f`, when `maybe` is `Just`." "```" "(def just (Maybe.Just 2))" "(def nothing (the (Maybe Int) (Maybe.Nothing)))" "" - "(when-just &(fn [] (IO.println \"just!\")) just)" + "(when-just (fn [] (IO.println \"just!\")) just)" "=> just!" - "(when-just &(fn [] (IO.println \"just!\")) nothing)" + "(when-just (fn [] (IO.println \"just!\")) nothing)" "=> " "```") (sig when-just (Fn [&(Fn [] ()) (Maybe a)] ())) @@ -71,15 +71,15 @@ other higher order concepts.") (Maybe.Just _) (~f) _ ())) - (doc when-nothing + (doc when-nothing "Executes a side-effect, `f`, when `maybe` is `Nothing`." "```" "(def just (Maybe.Just 2))" "(def nothing (the (Maybe Int) (Maybe.Nothing)))" "" - "(when-nothing &(fn [] (IO.println \"nothing!\")) nothing)" + "(when-nothing (fn [] (IO.println \"nothing!\")) nothing)" "=> nothing!" - "(when-nothing &(fn [] (IO.println \"nothing!\")) just)" + "(when-nothing (fn [] (IO.println \"nothing!\")) just)" "=> " "```") (sig when-nothing (Fn [&(Fn [] ()) (Maybe a)] ())) diff --git a/core/Filepath.carp b/core/Filepath.carp index 9e39b3802..620a5be74 100644 --- a/core/Filepath.carp +++ b/core/Filepath.carp @@ -8,7 +8,7 @@ (let [segments (split-by path &[\/]) n (dec (length &segments)) without-last (prefix &segments n)] - (concat &(copy-map &(fn [s] (str* s "/")) &without-last)))) + (concat &(copy-map (fn [s] (str* s "/")) &without-last)))) (doc file-from-path "removes the base name part of a path to a file, similar to the `filename` utility in Shell scripting.") (defn file-from-path [path] diff --git a/core/Generics.carp b/core/Generics.carp index 98ad01b23..04eb528ae 100644 --- a/core/Generics.carp +++ b/core/Generics.carp @@ -76,7 +76,7 @@ The margin of error is 0.00001.") (not (neg? x))) (defn id [x] x) -(defn const [x] (fn [_] x)) +(defn const [x] @(fn [_] x)) (defn null? [p] (Pointer.eq NULL (the (Ptr t) p))) diff --git a/core/Introspect.carp b/core/Introspect.carp index 756dac1c7..57bf1ba67 100644 --- a/core/Introspect.carp +++ b/core/Introspect.carp @@ -163,7 +163,7 @@ (reduce (with-copy + 2) 0 &[1 2 3]) => 6 ;; compare this with an inline anonymous function that achieves the same thing: - (reduce &(fn [x y] (+ x @y)) 0 &[1 2 3]) === (reduce (with-copy + 2) 0 &[1 2 3]) + (reduce (fn [x y] (+ x @y)) 0 &[1 2 3]) === (reduce (with-copy + 2) 0 &[1 2 3]) ``` This is useful when using higher-order functions that operate over structures that @@ -194,5 +194,5 @@ call (cons function (map (fn [x] (if (= target x) prox x)) local-names))] (if (> pos (Introspect.arity (eval function))) (macro-error "with-copy error: the specified argument position is greater than the given function's arity.") - (list 'ref (list 'fn local-names call))))) + (list 'fn local-names call)))) ) diff --git a/core/Map.carp b/core/Map.carp index f654932e1..427f9a522 100644 --- a/core/Map.carp +++ b/core/Map.carp @@ -119,11 +119,11 @@ @(Pair.b (Array.unsafe-nth (entries b) i))) (defn set-idx [b i val] - (do (Array.aupdate! (entries &b) i &(fn [p] (Pair.set-b p @val))) + (do (Array.aupdate! (entries &b) i (fn [p] (Pair.set-b p @val))) b)) (defn set-idx! [b i val] - (Array.aupdate! (entries b) i &(fn [p] (Pair.set-b p @val)))) + (Array.aupdate! (entries b) i (fn [p] (Pair.set-b p @val)))) (defn push-back [b k v] (do (Array.push-back! (entries &b) (Pair.init-from-refs k v)) @@ -238,9 +238,9 @@ (let [idx (Int.positive-mod (hash k) @(n-buckets &m)) in? (contains? &m k)] (update-len - (update-buckets m &(fn [b] - (let [n (Array.unsafe-nth &b idx)] - (Array.aset b idx (Bucket.put @n k v))))) + (update-buckets m (fn [b] + (let [n (Array.unsafe-nth &b idx)] + (Array.aset b idx (Bucket.put @n k v))))) &(if in? id Int.inc))))) (doc put! "Put a value v into map m, using the key k, in place.") @@ -264,7 +264,7 @@ (doc update "Update value at key k in map with function f, if it exists.") (defn update [m k f] (let [idx (Int.positive-mod (hash k) @(n-buckets &m))] - (update-buckets m &(fn [b] + (update-buckets m (fn [b] (let [n (Array.unsafe-nth &b idx) i (Bucket.find n k)] (if (<= 0 i) @@ -275,7 +275,7 @@ (doc update-with-default "Update value at key k in map with function f. If k doesn't exist in map, set k to (f v).") (defn update-with-default [m k f v] (let [idx (Int.positive-mod (hash k) @(n-buckets &m))] - (update-buckets m &(fn [b] + (update-buckets m (fn [b] (let [n (Array.unsafe-nth &b idx) i (Bucket.find n k)] (if (<= 0 i) @@ -297,7 +297,7 @@ (remove (shrink m) k) (let [idx (Int.positive-mod (hash k) @(n-buckets &m))] (update-len - (update-buckets m &(fn [b] + (update-buckets m (fn [b] (let [n (Array.unsafe-nth &b idx)] (Array.aset b idx (Bucket.shrink @n k))))) &Int.dec)))) @@ -318,7 +318,7 @@ (defn = [m1 m2] (and (= (length m1) (length m2)) ;; we could use contains? and get-with-default here to avoid requiring a (zero) for the value type - (all? &(fn [k v] (= v &(get m2 k))) m1))) + (all? (fn [k v] (= v &(get m2 k))) m1))) (implements = Map.=) (doc for-each "Execute the binary function f for all keys and values in the map m.") @@ -358,17 +358,17 @@ (doc merge "Merge two maps `m1` and `m2`. On collision the value from `m2` is preferred.") (defn merge [m1 m2] - (kv-reduce &(fn [m k v] (put m k v)) m1 m2)) + (kv-reduce (fn [m k v] (put m k v)) m1 m2)) (doc vals "Return an array of the values of the map. Order corresponds to order of (keys m)") (defn vals [m] - (kv-reduce &(fn [arr _ v] (Array.push-back arr @v)) + (kv-reduce (fn [arr _ v] (Array.push-back arr @v)) [] m)) (doc keys "Return an array of the keys of the map. Order corresponds to order of (vals m)") (defn keys [m] - (kv-reduce &(fn [arr k _] (Array.push-back arr @k)) + (kv-reduce (fn [arr k _] (Array.push-back arr @k)) [] m)) @@ -384,12 +384,12 @@ (doc to-array "Convert Map to Array of Pairs") (defn to-array [m] - (kv-reduce &(fn [arr k v] (Array.push-back arr (Pair.init-from-refs k v))) + (kv-reduce (fn [arr k v] (Array.push-back arr (Pair.init-from-refs k v))) [] m)) (defn str [m] - (let [res (kv-reduce &(fn [s k v] + (let [res (kv-reduce (fn [s k v] (String.join "" &[s @" " (prn @k) @" " (prn @v)])) @"{" m)] @@ -504,7 +504,7 @@ ;; The lifetime system really doesn't like this function, had to put in a bunch of copying to make it compile: ] (update-len - (update-buckets s &(fn [b] + (update-buckets s (fn [b] (let [n (Array.unsafe-nth &b idx)] (let [new-k @v] ;; HACK! (Array.aset b idx (SetBucket.grow n new-k)))))) @@ -533,7 +533,7 @@ (remove (shrink s) v) (let [idx (Int.positive-mod (hash v) @(n-buckets &s))] (update-len - (update-buckets s &(fn [b] + (update-buckets s (fn [b] (let [n (Array.unsafe-nth &b idx)] (Array.aset b idx (SetBucket.shrink n v))))) &Int.dec)))) @@ -551,7 +551,7 @@ (doc subset? "Is set-a a subset of set-b?") (defn subset? [set-a set-b] - (all? &(fn [e] (Set.contains? set-b e)) set-a)) + (all? (fn [e] (Set.contains? set-b e)) set-a)) (defn = [set-a set-b] (and (= (Set.length set-a) (Set.length set-b)) @@ -590,7 +590,7 @@ (doc intersection "Set of elements that are in both set-a and set-b") (defn intersection [set-a set-b] - (reduce &(fn [s a] (if (Set.contains? set-b a) (Set.put s a) s)) + (reduce (fn [s a] (if (Set.contains? set-b a) (Set.put s a) s)) (Set.create) set-a)) @@ -608,10 +608,10 @@ (doc to-array "Convert Set to Array of elements") (defn to-array [s] - (reduce &(fn [arr elt] (Array.push-back arr @elt)) [] s)) + (reduce (fn [arr elt] (Array.push-back arr @elt)) [] s)) (defn str [set] - (let [res (reduce &(fn [s e] (String.join "" &[s @" " (prn e)])) + (let [res (reduce (fn [s e] (String.join "" &[s @" " (prn e)])) @"{" set)] (String.append &res " }"))) diff --git a/core/Pattern.carp b/core/Pattern.carp index 86c439146..71d04868e 100644 --- a/core/Pattern.carp +++ b/core/Pattern.carp @@ -6,13 +6,13 @@ information](../LanguageGuide.html#patterns).") (defmodule Pattern (register-type MatchResult [start Int, end Int]) (defmodule MatchResult - (defn ref-str [ref-matchres] - (fmt "(MatchResult start=%d end=%d)" - (MatchResult.start ref-matchres) + (defn ref-str [ref-matchres] + (fmt "(MatchResult start=%d end=%d)" + (MatchResult.start ref-matchres) (MatchResult.end ref-matchres) )) (implements str Pattern.MatchResult.ref-str) (implements prn Pattern.MatchResult.ref-str) - (defn str [matchres] + (defn str [matchres] (Pattern.MatchResult.ref-str &matchres) ) (implements str Pattern.MatchResult.str) (implements prn Pattern.MatchResult.str) @@ -38,7 +38,7 @@ information](../LanguageGuide.html#patterns).") Returns `-1` if it doesn’t find a matching pattern.") (defn find [pattern data] @(Pattern.MatchResult.start &(Pattern.match pattern data)) ) - + (doc find-all "finds all indices of a pattern in a string. The patterns may _not_ overlap. Returns `[]` if it doesn’t find a matching pattern.") @@ -54,11 +54,11 @@ Returns `[]` if it doesn’t find a matching pattern.") (set! start @(MatchResult.end &found)) ) result )) (defn find-all [pattern data] - (Array.copy-map - &(fn [m] @(MatchResult.start m)) + (Array.copy-map + (fn [m] @(MatchResult.start m)) &(find-all-matches pattern data) )) - - + + (doc match-groups "finds the match groups of the first match of a pattern in a string. @@ -105,8 +105,8 @@ list of those characters.") (Pattern.init &(str* @"[" (String.from-chars chars) @"]"))) (defn global-match-str [pattern data] - (Array.copy-map - &(fn [m] (Maybe.unsafe-from (extract m data))) + (Array.copy-map + (fn [m] (Maybe.unsafe-from (extract m data))) &(find-all-matches pattern data))) @@ -199,7 +199,7 @@ list of those characters.") (doc words "splits a string into words.") (defn words [s] - (Array.endo-filter &(fn [s] (not (empty? s))) (split-by s &[\tab \space \newline]))) + (Array.endo-filter (fn [s] (not (empty? s))) (split-by s &[\tab \space \newline]))) (doc lines "splits a string into lines.") (defn lines [s] diff --git a/core/SDL.carp b/core/SDL.carp index c3e202ba9..436354fbb 100644 --- a/core/SDL.carp +++ b/core/SDL.carp @@ -340,7 +340,7 @@ framework](https://www.libsdl.org/).") (hidden reduce-events) (defn reduce-events [app f state-to-reduce-over] - (Array.reduce &(fn [s e] (~f app s e)) ;; Note, this will malloc an environment that captures the 'app' variable. + (Array.reduce (fn [s e] (~f app s e)) ;; Note, this will malloc an environment that captures the 'app' variable. state-to-reduce-over &(SDL.Event.all))) diff --git a/core/StaticArray.carp b/core/StaticArray.carp index 9c841db78..534740a3e 100644 --- a/core/StaticArray.carp +++ b/core/StaticArray.carp @@ -167,7 +167,7 @@ If the array is empty, returns `Nothing`") (doc sum "sums an array (elements must support `+` and `zero`).") (defn sum [xs] - (reduce &(fn [x y] (+ x @y)) (zero) xs)) + (reduce (fn [x y] (+ x @y)) (zero) xs)) (doc index-of "gets the index of element `e` in an array and wraps it on a `Just`. diff --git a/core/String.carp b/core/String.carp index e4e02eea9..b5b621132 100644 --- a/core/String.carp +++ b/core/String.carp @@ -5,7 +5,7 @@ (hidden tolower-) ; helper func for String.ascii-to-lower (register tolower- (Fn [Byte] Byte) "tolower") (hidden toupper-) ; helper func for String.ascii-to-upper - (register toupper- (Fn [Byte] Byte) "toupper") + (register toupper- (Fn [Byte] Byte) "toupper") ) (doc String "is the string data type for representing text.") @@ -181,10 +181,10 @@ (doc ascii-to-lower "converts each character in this string to lower case using tolower() from standard C library. Note: this will only work for ASCII characters.") (defn ascii-to-lower [s] - (String.from-bytes &(Array.endo-map &(fn [c] (Byte.tolower- c)) (String.to-bytes s))) ) + (String.from-bytes &(Array.endo-map (fn [c] (Byte.tolower- c)) (String.to-bytes s))) ) (doc ascii-to-upper "converts each character in this string to upper case using toupper() from standard C library. Note: this will only work for ASCII characters.") (defn ascii-to-upper [s] - (String.from-bytes &(Array.endo-map &(fn [c] (Byte.toupper- c)) (String.to-bytes s))) ) + (String.from-bytes &(Array.endo-map (fn [c] (Byte.toupper- c)) (String.to-bytes s))) ) ) (defmodule StringCopy @@ -517,4 +517,3 @@ (cons (String.head s) (String.to-list (String.tail s))))) ) ) - diff --git a/core/Vector.carp b/core/Vector.carp index 32b59fd13..9a3c4424f 100644 --- a/core/Vector.carp +++ b/core/Vector.carp @@ -9,21 +9,21 @@ (f @(y v)))) (defn zip [f a b] - (init (f @(x a) @(x b)) - (f @(y a) @(y b)))) + (init (~f @(x a) @(x b)) + (~f @(y a) @(y b)))) (defn vreduce [f i v] - (f (f i @(x v)) @(y v))) + (~f (~f i @(x v)) @(y v))) (defn random [] (init (random-0-1) (random-0-1))) (implements random Vector2.random) (defn add [a b] - (zip + a b)) + (zip &+ a b)) (defn sub [a b] - (zip - a b)) + (zip &- a b)) (defn mul [a n] (init (* @(x a) n) @@ -35,14 +35,14 @@ (doc vapprox "Check whether the vectors a and b are approximately equal.") (defn vapprox [a b] - (vreduce (fn [i v] (and i v)) true &(zip Generics.approx a b))) + (vreduce (fn [i v] (and i v)) true &(zip &Generics.approx a b))) (defn sum [o] - (vreduce + (zero) o)) + (vreduce &+ (zero) o)) (doc dot "Get the dot product of the two vectors x and y.") (defn dot [a b] - (sum &(zip * a b))) + (sum &(zip &* a b))) (doc mag-sq "Get the squared magnitude of a vector.") (defn mag-sq [o] @@ -103,17 +103,17 @@ (doc Vector3 "is a three-dimensional vector data type.") (defmodule Vector3 (defn map [f v] - (init (f @(x v)) - (f @(y v)) - (f @(z v)))) + (init (~f @(x v)) + (~f @(y v)) + (~f @(z v)))) (defn zip [f a b] - (init (f @(x a) @(x b)) - (f @(y a) @(y b)) - (f @(z a) @(z b)))) + (init (~f @(x a) @(x b)) + (~f @(y a) @(y b)) + (~f @(z a) @(z b)))) (defn vreduce [f i v] - (f (f (f i @(x v)) @(y v)) @(z v))) + (~f (~f (~f i @(x v)) @(y v)) @(z v))) (defn random [] (init (random-0-1) (random-0-1) (random-0-1))) @@ -121,19 +121,19 @@ (doc vapprox "Check whether the vectors a and b are approximately equal.") (defn vapprox [a b] - (vreduce (fn [i v] (and i v)) true &(zip Generics.approx a b))) + (vreduce (fn [i v] (and i v)) true &(zip &Generics.approx a b))) (defn add [a b] - (zip + a b)) + (zip &+ a b)) (defn sub [a b] - (zip - a b)) + (zip &- a b)) (defn cmul [a b] - (zip * a b)) + (zip &* a b)) (defn neg [a] - (map neg a)) + (map &neg a)) (defn mul [v n] (map (fn [c] (* n c)) v)) @@ -142,11 +142,11 @@ (map (fn [c] (/ c n)) v)) (defn sum [o] - (vreduce + (zero) o)) + (vreduce &+ (zero) o)) (doc dot "Get the dot product of the two vectors x and y.") (defn dot [a b] - (sum &(zip * a b))) + (sum &(zip &* a b))) (doc mag-sq "Get the squared magnitude of a vector.") (defn mag-sq [o] @@ -218,8 +218,8 @@ array-backed.") (let [total (Array.allocate (Array.length a))] (do (for [i 0 (Array.length a)] - (Array.aset-uninitialized! &total i (f @(Array.unsafe-nth a i) - @(Array.unsafe-nth b i)))) + (Array.aset-uninitialized! &total i (~f @(Array.unsafe-nth a i) + @(Array.unsafe-nth b i)))) (init (Array.length a) total)))) (defn zip [f a b] @@ -228,21 +228,21 @@ array-backed.") (Maybe.Nothing))) (defn add [a b] - (zip + a b)) + (zip &+ a b)) (defn sub [a b] - (zip - a b)) + (zip &- a b)) (defn mul [a n] - (zip- * (v a) &(Array.replicate @(VectorN.n a) &n))) + (zip- &* (v a) &(Array.replicate @(VectorN.n a) &n))) (defn div [a n] - (zip- / (v a) &(Array.replicate @(VectorN.n a) &n))) + (zip- &/ (v a) &(Array.replicate @(VectorN.n a) &n))) (doc dot "Get the dot product of the two vectors x and y.") (defn dot [x y] - (Maybe.apply (zip * x y) - &(fn [x] (Array.reduce &(fn [x y] (+ x @y)) (zero) (v &x))))) + (Maybe.apply (zip &* x y) + (fn [x] (Array.reduce (fn [x y] (+ x @y)) (zero) (v &x))))) (doc mag-sq "Get the squared magnitude of a vector.") (defn mag-sq [o] @@ -254,7 +254,7 @@ array-backed.") (doc dist "Get the distance between the vectors a and b.") (defn dist [a b] - (Maybe.apply (sub b a) &(fn [s] (mag &s)))) + (Maybe.apply (sub b a) (fn [s] (mag &s)))) (doc normalize "Normalize a vector.") (defn normalize [o] @@ -266,21 +266,21 @@ array-backed.") (doc angle-between "Get the angle between two vectors a and b.") (defn angle-between [a b] (Maybe.apply (VectorN.dot a b) - &(fn [x] + (fn [x] (let [dmm (/ x (* (VectorN.mag a) (VectorN.mag b)))] (acos (clamp--1-1 dmm)))))) (doc anti-parallel? "Check whether the two vectors a and b are anti-parallel.") (defn anti-parallel? [a b] - (Maybe.apply (angle-between a b) &(fn [x] (= x pi)))) + (Maybe.apply (angle-between a b) (fn [x] (= x pi)))) (doc parallel? "Check whether the two vectors a and b are parallel.") (defn parallel? [a b] - (Maybe.apply (angle-between a b) &(fn [x] (zero? x)))) + (Maybe.apply (angle-between a b) (fn [x] (zero? x)))) (doc perpendicular? "Check whether the two vectors a and b are perpendicular.") (defn perpendicular? [a b] - (Maybe.apply (angle-between a b) &(fn [x] (= x (Generics.half-pi))))) + (Maybe.apply (angle-between a b) (fn [x] (= x (Generics.half-pi))))) (doc vlerp "Linearly interpolate between the two vectors a and b by amnt (between 0 and 1).") (defn vlerp [a b amnt] diff --git a/examples/nested_lambdas.carp b/examples/nested_lambdas.carp index f0f15b20b..8fb6e9cfc 100644 --- a/examples/nested_lambdas.carp +++ b/examples/nested_lambdas.carp @@ -1,18 +1,18 @@ -(defn my-curry [f] (fn [x] (fn [y] (f x y)))) -(defn double-curry [f] (fn [x] (fn [y] (fn [z] (f x y z))))) +(defn my-curry [f] @(fn [x] @(fn [y] (f x y)))) +(defn double-curry [f] @(fn [x] @(fn [y] @(fn [z] (f x y z))))) (defn make-cb [] - ((fn [] - (let [x "hi"] - (fn [] (IO.println x)))))) + (~(fn [] + (let [x "hi"] + @(fn [] (IO.println x)))))) (defn make-cb2 [] - ((fn [] - (let [x "hello" - f (fn [] (IO.println x))] - f)))) + (~(fn [] + (let [x "hello" + f @(fn [] (IO.println x))] + f)))) (defn main [] (do ((make-cb)) ((make-cb2)) - (((my-curry (fn [x y] (Int.+ x y))) 1) 2))) + (((my-curry @(fn [x y] (Int.+ x y))) 1) 2))) diff --git a/examples/static_array.carp b/examples/static_array.carp index 7aa099110..320850f53 100644 --- a/examples/static_array.carp +++ b/examples/static_array.carp @@ -1,4 +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)))) + (StaticArray.map! xs (fn [x] (* @x 2))) + (println* (StaticArray.reduce (fn [total x] (+ total @x)) 0 xs)))) diff --git a/src/Concretize.hs b/src/Concretize.hs index 0fdb21707..a58b584a2 100644 --- a/src/Concretize.hs +++ b/src/Concretize.hs @@ -250,21 +250,21 @@ visitApp _ _ _ _ _ x = pure (Left (CannotConcretize x)) -- resolvable/retrievable lambda. mkLambda :: Visitor mkLambda visited allowAmbig _ tenv env root@(ListPat (FnPat fn arr@(ArrPat args) body)) = - let capturedVars = filter (\xobj -> xobjObj (toGeneralSymbol xobj) `notElem` (map xobjObj args)) (collectCapturedVars body) + let capturedVars = filter (\xobj -> xobjObj (toGeneralSymbol xobj) `notElem` map xobjObj args) (collectCapturedVars body) -- Create a new (top-level) function that will be used when the lambda is called. -- Its name will contain the name of the (normal, non-lambda) function it's contained within, -- plus the identifier of the particular s-expression that defines the lambda. - SymPath spath name = (last visited) - Just funcTy = xobjTy root - lambdaPath = SymPath spath ("_Lambda_" ++ lambdaToCName name (envFunctionNestingLevel env) ++ "_" ++ show (maybe 0 infoIdentifier (xobjInfo root)) ++ "_env") + SymPath spath name = last visited + Just (RefTy lambdaTyNoRef _) = xobjTy root + lambdaPath = SymPath spath ("_Lambda_" ++ lambdaToCName name (envFunctionNestingLevel env) ++ "_" ++ show (maybe 0 infoIdentifier (xobjInfo root)) ++ "_callback") lambdaNameSymbol = XObj (Sym lambdaPath Symbol) (Just dummyInfo) Nothing -- Anonymous functions bound to a let name might call themselves. These recursive instances will have already been qualified as LookupRecursive symbols. -- Rename the recursive calls according to the generated lambda name so that we can call these correctly from C. - renameRecursives (XObj (Sym _ LookupRecursive) si st) = (XObj (Sym lambdaPath LookupRecursive) si st) + renameRecursives (XObj (Sym _ LookupRecursive) si st) = XObj (Sym lambdaPath LookupRecursive) si st renameRecursives x = x recBody = walk renameRecursives body environmentTypeName = pathToC lambdaPath ++ "_ty" - tyPath = (SymPath [] environmentTypeName) + tyPath = SymPath [] environmentTypeName extendedArgs = if null capturedVars then arr @@ -281,7 +281,7 @@ mkLambda visited allowAmbig _ tenv env root@(ListPat (FnPat fn arr@(ArrPat args) ) ) ) - lambdaCallback = XObj (Lst [XObj (Defn (Just (Set.fromList capturedVars))) (Just dummyInfo) Nothing, lambdaNameSymbol, extendedArgs, recBody]) (xobjInfo root) (xobjTy root) + lambdaCallback = XObj (Lst [XObj (Defn (Just (Set.fromList capturedVars))) (Just dummyInfo) Nothing, lambdaNameSymbol, extendedArgs, recBody]) (xobjInfo root) (Just lambdaTyNoRef) -- The lambda will also carry with it a special made struct containing the variables it captures -- (if it captures at least one variable) structMemberPairs = @@ -312,7 +312,7 @@ mkLambda visited allowAmbig _ tenv env root@(ListPat (FnPat fn arr@(ArrPat args) -- TODO: Support modules in type envs. extendedTypeEnv = replaceLeft (FailedToAddLambdaStructToTyEnv tyPath environmentStruct) (insert tenv tyPath (toBinder environmentStruct)) in --(fromMaybe UnitTy (xobjTy root)) - case (extendedTypeEnv >>= \ext -> concretizeDefinition allowAmbig ext env visited lambdaCallback funcTy) of + case extendedTypeEnv >>= \ext -> concretizeDefinition allowAmbig ext env visited lambdaCallback lambdaTyNoRef of Left e -> pure (Left e) Right (concreteLiftedLambda, deps) -> do @@ -327,7 +327,7 @@ mkLambda visited allowAmbig _ tenv env root@(ListPat (FnPat fn arr@(ArrPat args) modify (deleterDeps ++) modify (copyFn :) modify (copyDeps ++) - pure (Right [XObj (Fn (Just lambdaPath) (Set.fromList capturedVars)) (xobjInfo fn) (xobjTy fn), arr, recBody]) + pure (Right [XObj (Fn (Just lambdaPath) (Set.fromList capturedVars)) (xobjInfo fn) (xobjTy fn), arr, body]) mkLambda _ _ _ _ _ root = pure (Left (CannotConcretize root)) -- | Concretize an anonymous function (fn [args...] ) @@ -464,7 +464,7 @@ collectCapturedVars root = removeDuplicates (map decreaseCaptureLevel (visit' ro LookupLocal (Capture n) -> if n <= 1 then Symbol - else LookupLocal (Capture (n -1)) + else LookupLocal (Capture (n - 1)) _ -> error "decreasecapturelevel1" ) ) diff --git a/src/Constraints.hs b/src/Constraints.hs index a56ea57de..50cfb7185 100644 --- a/src/Constraints.hs +++ b/src/Constraints.hs @@ -27,6 +27,7 @@ data ConstraintOrder | OrdArrHead | OrdArg | OrdCapture + | OrdFnRef | OrdDefnBody | OrdDefExpr | OrdLetBind diff --git a/src/Emit.hs b/src/Emit.hs index 9487b5cb4..d9ced2fb4 100644 --- a/src/Emit.hs +++ b/src/Emit.hs @@ -205,6 +205,7 @@ toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent roo pure overrideWithName visitSymbol indent xobj@(XObj sym@(Sym path lookupMode) (Just i) ty) = let Just t = ty + functionLike = isFunctionType t || isRefToFunctionType t in if isTypeGeneric t then error @@ -216,11 +217,16 @@ toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent roo ++ prettyInfoFromXObj xobj ) else - if isFunctionType t && not (isLookupLocal lookupMode) && not (isGlobalVariableLookup lookupMode) + if functionLike && not (isLookupLocal lookupMode) && not (isGlobalVariableLookup lookupMode) then do let var = freshVar i appendToSrc (addIndent indent ++ "Lambda " ++ var ++ " = { .callback = (void*)" ++ pathToC path ++ ", .env = NULL, .delete = NULL, .copy = NULL }; //" ++ show sym ++ "\n") - pure var + if isRefToFunctionType t + then do + let refVar = var ++ "_ref" + appendToSrc (addIndent indent ++ "Lambda *" ++ refVar ++ " = &" ++ var ++ ";\n") + pure refVar + else pure var else pure $ case lookupMode of LookupLocal (Capture _) -> "_env->" ++ pathToC path _ -> pathToC path @@ -253,12 +259,12 @@ toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent roo -- Fn / λ [XObj (Fn name set) _ _, XObj (Arr _) _ _, _] -> do - let retVar = freshVar info + let lambdaVar = freshVar info capturedVars = Set.toList set Just callback = name callbackMangled = pathToC callback needEnv = not (null capturedVars) - lambdaEnvTypeName = (SymPath [] (callbackMangled ++ "_ty")) -- The name of the struct is the callback name with suffix '_ty'. + lambdaEnvTypeName = SymPath [] (callbackMangled ++ "_ty") -- The name of the struct is the callback name with suffix '_ty'. lambdaEnvType = StructTy (ConcreteNameTy lambdaEnvTypeName) [] lambdaEnvName = freshVar info ++ "_env" appendToSrc @@ -271,15 +277,11 @@ toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent roo when needEnv $ do appendToSrc - ( addIndent indent ++ tyToC lambdaEnvType ++ " *" ++ lambdaEnvName - ++ " = CARP_MALLOC(sizeof(" - ++ tyToC lambdaEnvType - ++ "));\n" - ) + (addIndent indent ++ tyToC lambdaEnvType ++ " " ++ lambdaEnvName ++ ";\n") mapM_ ( \(XObj (Sym path lookupMode) _ _) -> appendToSrc - ( addIndent indent ++ lambdaEnvName ++ "->" + ( addIndent indent ++ lambdaEnvName ++ "." ++ pathToC path ++ " = " ++ ( case lookupMode of @@ -290,12 +292,14 @@ toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent roo ) ) (remove (isUnit . forceTy) capturedVars) - appendToSrc (addIndent indent ++ "Lambda " ++ retVar ++ " = {\n") + appendToSrc (addIndent indent ++ "Lambda " ++ lambdaVar ++ " = {\n") appendToSrc (addIndent indent ++ " .callback = (void*)" ++ callbackMangled ++ ",\n") - appendToSrc (addIndent indent ++ " .env = " ++ (if needEnv then lambdaEnvName else "NULL") ++ ",\n") + appendToSrc (addIndent indent ++ " .env = " ++ (if needEnv then "&" ++ lambdaEnvName else "NULL") ++ ",\n") appendToSrc (addIndent indent ++ " .delete = (void*)" ++ (if needEnv then "" ++ show lambdaEnvTypeName ++ "_delete" else "NULL") ++ ",\n") appendToSrc (addIndent indent ++ " .copy = (void*)" ++ (if needEnv then "" ++ show lambdaEnvTypeName ++ "_copy" else "NULL") ++ "\n") appendToSrc (addIndent indent ++ "};\n") + let retVar = freshVar info ++ "_ref" + appendToSrc (addIndent indent ++ "Lambda* " ++ retVar ++ " = &" ++ lambdaVar ++ ";\n") pure retVar -- Def [XObj Def _ _, XObj (Sym path _) _ _, expr] -> diff --git a/src/GenerateConstraints.hs b/src/GenerateConstraints.hs index 9fe9cbe70..f2f3260bf 100644 --- a/src/GenerateConstraints.hs +++ b/src/GenerateConstraints.hs @@ -21,7 +21,15 @@ genConstraints _ root rootSig = fmap sort (gen root) insideBodyConstraints <- gen body xobjType <- toEither (xobjTy xobj) (DefnMissingType xobj) bodyType <- toEither (xobjTy body) (ExpressionMissingType xobj) - let (FuncTy argTys retTy lifetimeTy) = xobjType + let (argTys, retTy, lifetimeTy, fnRefLt) = + case xobjType of + (FuncTy a r l) -> (a, r, l, Nothing) + (RefTy (FuncTy a r l) rlt) -> (a, r, l, Just rlt) + _ -> error ("Invalid function type for " ++ pretty xobj ++ ": " ++ show xobjType) + refConstr = + case fnRefLt of + Just fnRefLt' -> [Constraint fnRefLt' lifetimeTy xobj xobj xobj OrdFnRef] + Nothing -> [] bodyConstr = Constraint retTy bodyType xobj body xobj OrdDefnBody argConstrs = zipWith3 (\a b aObj -> Constraint a b aObj xobj xobj OrdArg) (List.map forceTy args) argTys args -- The constraint generated by type signatures, like (sig foo (Fn ...)): @@ -49,7 +57,7 @@ genConstraints _ root rootSig = fmap sort (gen root) (List.map forceTy captureList) captureList ) - pure (bodyConstr : argConstrs ++ insideBodyConstraints ++ capturesConstrs ++ sigConstr) + pure (bodyConstr : argConstrs ++ insideBodyConstraints ++ capturesConstrs ++ sigConstr ++ refConstr) gen xobj = case xobjObj xobj of Lst lst -> case lst of diff --git a/src/InitialTypes.hs b/src/InitialTypes.hs index bd0446409..a262c2c82 100644 --- a/src/InitialTypes.hs +++ b/src/InitialTypes.hs @@ -217,8 +217,9 @@ initialTypes typeEnv rootEnv root = evalState (visit rootEnv root) 0 [XObj LocalDef _ _, XObj (Sym path _) si _, XObj (Lst [fn@(XObj (Fn _ _) _ _), XObj (Arr argList) argsi argst, body]) _ _] -> do (argTypes, returnType, funcScopeEnv) <- getTys env argList + refLt <- genVarTy lt <- genVarTy - let funcTy = Just (FuncTy argTypes returnType lt) + let funcTy = Just (RefTy (FuncTy argTypes returnType lt) refLt) typedNameSymbol = XObj (Sym path LookupRecursive) si funcTy Right envWithSelf = E.insertX funcScopeEnv path typedNameSymbol visitedBody <- visit envWithSelf body @@ -235,8 +236,9 @@ initialTypes typeEnv rootEnv root = evalState (visit rootEnv root) 0 [fn@(XObj (Fn _ _) _ _), XObj (Arr argList) argsi argst, body] -> do (argTypes, returnType, funcScopeEnv) <- getTys env argList + refLt <- genVarTy lt <- genVarTy - let funcTy = Just (FuncTy argTypes returnType lt) + let funcTy = Just (RefTy (FuncTy argTypes returnType lt) refLt) visitedBody <- visit funcScopeEnv body visitedArgs <- mapM (visit funcScopeEnv) argList pure $ do @@ -244,7 +246,8 @@ initialTypes typeEnv rootEnv root = evalState (visit rootEnv root) 0 okArgs <- sequence visitedArgs let final = XObj (Lst [fn, XObj (Arr okArgs) argsi argst, okBody]) i funcTy pure final --(trace ("FINAL: " ++ show final) final) - [XObj (Fn _ _) _ _, XObj (Arr _) _ _] -> pure (Left (NoFormsInBody xobj)) -- TODO: Special error message for lambdas needed? + [XObj (Fn _ _) _ _, XObj (Arr _) _ _] -> + pure (Left (NoFormsInBody xobj)) -- TODO: Special error message for lambdas needed? XObj fn@(Fn _ _) _ _ : _ -> pure (Left (InvalidObjExample fn xobj "(fn [] )")) -- Def diff --git a/src/Memory.hs b/src/Memory.hs index 2a20fce22..da85a67a0 100644 --- a/src/Memory.hs +++ b/src/Memory.hs @@ -135,10 +135,12 @@ manageMemory typeEnv globalEnv root = Right (XObj (Lst [defn, nameSymbol, args, okBody]) i t) -- Fn / λ (Lambda) - [fn@(XObj (Fn _ captures) _ _), args@(XObj (Arr _) _ _), body] -> + [fn@(XObj (Fn _ _) _ _), args@(XObj (Arr _) _ _), body] -> do - manage typeEnv globalEnv xobj -- manage inner lambdas but leave their bodies unvisited, they will be visited in the lifted version... - mapM_ (unmanage typeEnv globalEnv) captures + -- Manage inner lambdas but leave their bodies unvisited, they will be visited in the lifted version. + -- Note: By not unmanaging the captures, they will get deleted at end of current scope (outside of the lambda). + manage typeEnv globalEnv xobj + addToLifetimesMappingsIfRef False xobj pure (Right (XObj (Lst [fn, args, body]) i t)) -- Def diff --git a/src/TypePredicates.hs b/src/TypePredicates.hs index 4cde4feaa..33cbf21ba 100644 --- a/src/TypePredicates.hs +++ b/src/TypePredicates.hs @@ -25,6 +25,11 @@ isFunctionType :: Ty -> Bool isFunctionType FuncTy {} = True isFunctionType _ = False +-- | Is this type a ref to a function type? +isRefToFunctionType :: Ty -> Bool +isRefToFunctionType (RefTy FuncTy {} _) = True +isRefToFunctionType _ = False + -- | Is this type a struct type? isStructType :: Ty -> Bool isStructType (StructTy _ _) = True diff --git a/test/array.carp b/test/array.carp index cc4676b3f..5e25de3fc 100644 --- a/test/array.carp +++ b/test/array.carp @@ -264,30 +264,30 @@ (empty? &[1]) "empty? works as expected II") (assert-true test - (any? &(fn [x] (= 0 @x)) &(range-or-default 0 10 1)) + (any? (fn [x] (= 0 @x)) &(range-or-default 0 10 1)) "any? works as expected I") (assert-false test - (any? &(fn [x] (= 0 @x)) &(range-or-default 1 10 1)) + (any? (fn [x] (= 0 @x)) &(range-or-default 1 10 1)) "any? works as expected II") (assert-true test - (all? &(fn [x] (< 0 @x)) &(range-or-default 1 10 1)) + (all? (fn [x] (< 0 @x)) &(range-or-default 1 10 1)) "all? works as expected I") (assert-false test - (all? &(fn [x] (= 0 @x)) &(range-or-default 10 1 -1)) + (all? (fn [x] (= 0 @x)) &(range-or-default 10 1 -1)) "all? works as expected II") (assert-ref-equal test (Maybe.Just 3) - (find &(fn [x] (= 3 @x)) &(range-or-default 1 10 1)) + (find (fn [x] (= 3 @x)) &(range-or-default 1 10 1)) "find works as expected I") (assert-nothing test - &(find &(fn [x] (= 0 @x)) &(range-or-default 1 10 1)) + &(find (fn [x] (= 0 @x)) &(range-or-default 1 10 1)) "find works as expected II") (assert-nothing test - &(find-index &(fn [i] (Int.even? @i)) &[1 3 5]) + &(find-index (fn [i] (Int.even? @i)) &[1 3 5]) "find-index works I") (assert-ref-equal test (Maybe.Just 1) - (find-index &(fn [i] (Int.even? @i)) &[1 8 5]) + (find-index (fn [i] (Int.even? @i)) &[1 8 5]) "find-index works II") (assert-equal test 2 @@ -295,7 +295,7 @@ "element-count works as expected") (assert-equal test 2 - (predicate-count &[1 8 5 10 3] &(fn [i] (Int.even? @i))) + (predicate-count &[1 8 5 10 3] (fn [i] (Int.even? @i))) "predicate-count works") (assert-equal test &1 @@ -319,7 +319,7 @@ "remove-nth works") (assert-ref-equal test [1.0 1.5 2.0 2.5] - (unreduce 1.0 &(fn [x] (< x 3.0)) &(fn [x] (+ x 0.5))) + (unreduce 1.0 (fn [x] (< x 3.0)) (fn [x] (+ x 0.5))) "unreduce works") (assert-true test (contains? &[0 1 2] &1) @@ -333,19 +333,19 @@ "from-static works") (assert-ref-equal test (Pair.init 6 [2 4 6]) - (map-reduce &(fn [acc x] (Pair.init (+ @x @acc) (* @x 2))) 0 &[1 2 3]) + (map-reduce (fn [acc x] (Pair.init (+ @x @acc) (* @x 2))) 0 &[1 2 3]) "map-reduce works") (assert-ref-equal test [0 1 2 3 4 5] - (scan &(fn [x y] (+ @x @y)) 0 &[1 1 1 1 1]) + (scan (fn [x y] (+ @x @y)) 0 &[1 1 1 1 1]) "scan works") (assert-ref-equal test [@"" @"a" @"ab" @"abc"] - (Array.scan &(fn [a b] (String.append a b)) @"" &[@"a" @"b" @"c"]) + (Array.scan (fn [a b] (String.append a b)) @"" &[@"a" @"b" @"c"]) "scan works on managed type") (assert-ref-equal test [1 2 3 4 5] - (endo-scan &(fn [x y] (+ @x @y)) [1 1 1 1 1]) + (endo-scan (fn [x y] (+ @x @y)) [1 1 1 1 1]) "endo-scan works") (assert-ref-equal test [@"a" @"ab" @"abc"] diff --git a/test/function.carp b/test/function.carp index fa053c4f5..00ab228f7 100644 --- a/test/function.carp +++ b/test/function.carp @@ -8,13 +8,15 @@ (deftest test (assert-equal test - (let [x 42 fnfn (fn [] @&x)] - (runner (Function.unsafe-ptr &fnfn) (Function.unsafe-env-ptr &fnfn))) + (let [x 42 + fnfn (fn [] @&x)] + (runner (Function.unsafe-ptr fnfn) (Function.unsafe-env-ptr fnfn))) 42 "Function.unsafe-ptr & Function.unsafe-env-ptr works as expected") (assert-equal test - (let [x 42 fnfn (fn [y] (Int.copy y))] - (runner (Function.unsafe-ptr &fnfn) (Unsafe.coerce &x))) + (let [x 42 + fnfn (fn [y] (Int.copy y))] + (runner (Function.unsafe-ptr fnfn) (Unsafe.coerce &x))) 42 "Function.unsafe-ptr & Unsafe.coerce works as expected")) diff --git a/test/map.carp b/test/map.carp index 96239989d..d5b6cb6cf 100644 --- a/test/map.carp +++ b/test/map.carp @@ -118,12 +118,12 @@ ) (assert-equal test true - (Map.all? &(fn [k v] (or (Int.even? @k) @v)) &{1 true 2 false 4 false}) + (Map.all? (fn [k v] (or (Int.even? @k) @v)) &{1 true 2 false 4 false}) "Map.all? works I" ) (assert-equal test false - (Map.all? &(fn [k v] (or (Int.even? @k) @v)) &{1 true 2 false 5 false}) + (Map.all? (fn [k v] (or (Int.even? @k) @v)) &{1 true 2 false 5 false}) "Map.all? works II" ) (assert-equal test @@ -178,13 +178,13 @@ ) (assert-equal test "{ 1 12 3 34 }" - &(str &(Map.endo-map &(fn [k v] (+ @v (* 10 @k))) + &(str &(Map.endo-map (fn [k v] (+ @v (* 10 @k))) {1 2 3 4})) "endo-map works" ) (assert-equal test 641 - (Map.kv-reduce &(fn [sum k v] (+ sum (+ (* 100 @k) (* 10 @v)))) + (Map.kv-reduce (fn [sum k v] (+ sum (+ (* 100 @k) (* 10 @v)))) 1 &{1 1 2 1 3 2}) "kv-reduce works" @@ -272,17 +272,17 @@ ) (assert-equal test true - (Set.all? &(fn [i] (Int.even? @i)) &(Set.from-array &[2 4 6])) + (Set.all? (fn [i] (Int.even? @i)) &(Set.from-array &[2 4 6])) "Set.all? works I" ) (assert-equal test false - (Set.all? &(fn [i] (Int.even? @i)) &(Set.from-array &[2 4 7])) + (Set.all? (fn [i] (Int.even? @i)) &(Set.from-array &[2 4 7])) "Set.all? works II" ) (assert-equal test true - (Set.all? &(fn [i] false) &(the (Set Int) (Set.create))) + (Set.all? (fn [i] false) &(the (Set Int) (Set.create))) "Set.all? works on empty set" ) (assert-equal test @@ -317,7 +317,7 @@ ) (assert-equal test 61 - (Set.reduce &(fn [state i] (+ state (* 10 @i))) + (Set.reduce (fn [state i] (+ state (* 10 @i))) 1 &(Set.from-array &[1 2 3])) "reduce works" diff --git a/test/memory.carp b/test/memory.carp index d3aaaca8c..018d78c44 100644 --- a/test/memory.carp +++ b/test/memory.carp @@ -201,12 +201,12 @@ (defn array-endo-filter [] (let [xs [@"a" @"b" @"c" @"b" @"a" @"c"] - result (Array.endo-filter &(fn [x] (= x "b")) xs)] + result (Array.endo-filter (fn [x] (= x "b")) xs)] (assert (= &[@"b" @"b"] &result)))) (defn array-copy-filter [] (let [xs [@"a" @"b" @"c" @"a" @"c"] - result (Array.copy-filter &(fn [x] (= x "b")) &xs)] + result (Array.copy-filter (fn [x] (= x "b")) &xs)] (assert (= &[@"b"] &result)))) (defn array-first [] @@ -330,7 +330,7 @@ (assert (= &[@"1" @"2" @"3" @"4"] &ys)))) (defn array-map-reduce [] - (let [r (map-reduce &(fn [acc x] (Pair.init (append acc x) (append "-" x))) @"" &[@"1" @"2" @"3"])] + (let [r (map-reduce (fn [acc x] (Pair.init (append acc x) (append "-" x))) @"" &[@"1" @"2" @"3"])] (assert (= &r &(Pair.init @"123" [@"-1" @"-2" @"-3"]))))) (defn static-array-aupdate! [] @@ -349,34 +349,34 @@ (let [s @"X" f (fn [] @&s)] ;; each call needs to produce a new copy of the string (do - (assert (= @"X" (f))) - (assert (= @"X" (f))) - (assert (= @"X" (f)))))) + (assert (= @"X" (~f))) + (assert (= @"X" (~f))) + (assert (= @"X" (~f)))))) (defn lambda-2 [] (let [xs [10 20 30] f (fn [ys] (Array.concat &[@&xs ys]))] - (assert (= &[10 20 30 40 50] &(f [40 50]))))) + (assert (= &[10 20 30 40 50] &(~f [40 50]))))) (defn lambda-3 [] (let-do [stuff [100 200 300] f (fn [n] (copy (unsafe-nth &stuff n)))] - (assert (= 100 (f 0))) - (assert (= 200 (f 1))) - (assert (= 300 (f 2))))) + (assert (= 100 (~f 0))) + (assert (= 200 (~f 1))) + (assert (= 300 (~f 2))))) (defn lambda-4 [] (let-do [stuff [@"A" @"B" @"C"]] - (assert (= &[@"X" @"X" @"X"] &(copy-map &(fn [c] @"X") &stuff))))) + (assert (= &[@"X" @"X" @"X"] &(copy-map (fn [c] @"X") &stuff))))) (defn lambda-5 [] (let-do [stuff [@"A" @"B" @"C"]] - (assert (= &[@"X" @"X" @"X"] &(endo-map &(fn [c] @"X") stuff))))) + (assert (= &[@"X" @"X" @"X"] &(endo-map (fn [c] @"X") stuff))))) (defn lambda-6 [] (let [v 1 adder (fn [x] (+ v x)) - f @&adder + f @adder ] (assert (= 11 (f 10))))) @@ -465,7 +465,7 @@ (defn sumtype-10 [] (let [state 0] (match-ref &(Sum.One) - Sum.One (println* ((fn [] @&state))) + Sum.One (println* (~(fn [] @&state))) Sum.Two ()))) (deftype ExampleA diff --git a/test/output/test/produces-output/lambdas.carp.output.expected b/test/output/test/produces-output/lambdas.carp.output.expected index 18f1d7d17..3f0087d14 100644 --- a/test/output/test/produces-output/lambdas.carp.output.expected +++ b/test/output/test/produces-output/lambdas.carp.output.expected @@ -5,3 +5,4 @@ Hello, hello! [1 2 3] 2 [(Pair 1 2)] +hello diff --git a/test/produces-output/lambdas.carp b/test/produces-output/lambdas.carp index 5dd71b0ef..ff1067c5d 100644 --- a/test/produces-output/lambdas.carp +++ b/test/produces-output/lambdas.carp @@ -9,7 +9,7 @@ (defn create-function [] (let [x @"hello" - f (fn [] @&x)] ; Lambda takes ownership of the string, needs to copy it each time it returns it. + f @(fn [] @&x)] ; Lambda takes ownership of the string, needs to copy it each time it returns it. f)) ;; Example 2, returning a function @@ -27,7 +27,7 @@ (defn cap [capture-me] (let [and-me 1000] - (fn [not-me] + @(fn [not-me] (let [nor-me 100] (+ (+ (+ (+ global-variable capture-me) and-me) not-me) nor-me))))) @@ -41,11 +41,11 @@ ;; Example 6, handle various kinds of functions together (defn pow-to [exponent to] - (let [ff1 (fn [] ()) + (let [ff1 @(fn [] ()) ff2 @&ff1 to-copy @to upper (to-copy)] - (endo-map &(fn [x] (Int.pow x exponent)) (range-or-default 0 upper 1)))) + (endo-map (fn [x] (Int.pow x exponent)) (range-or-default 0 upper 1)))) (defn twenty [] 20) @@ -72,19 +72,29 @@ (~f 1)) (defn wrapper [f] - (call-with-1 &(fn [x] (~f x)))) + (call-with-1 (fn [x] (~f x)))) (defn example-9 [] (println* (wrapper &Int.inc))) ;; Example 10, more realistic example of capturing ref to function (defn update-bs [arr f] - (Array.endo-map &(fn [p] (Pair.update-b p f)) arr)) + (Array.endo-map (fn [p] (Pair.update-b p f)) arr)) (defn example-10 [] (let [arr [(Pair.init 1 1)]] (println* &(update-bs arr &Int.inc)))) +;; Example 11, capture ref and call the lambda later +(defn cap-ref [r] + (fn [] @r)) + +(defn example-11 [] + (let [s @"hello" + r &s + f (cap-ref r)] + (println* (~f)))) + (defn-do main [] ;;(example-1 "!") (example-2) @@ -95,4 +105,5 @@ (example-7) (example-8) (example-9) - (example-10)) + (example-10) + (example-11)) diff --git a/test/recursion.carp b/test/recursion.carp index 52437c860..e7b7508e3 100644 --- a/test/recursion.carp +++ b/test/recursion.carp @@ -23,8 +23,8 @@ ;; let bindings may be recursive in static contexts (issue #402) (defn letrec-test [] - (let [f (fn [x] (if (= x 1) x (f (dec x))))] - (f 10))) + (let [f (fn [x] (if (= x 1) x (~f (dec x))))] + (~f 10))) (deftest test (assert-equal test diff --git a/test/regression.carp b/test/regression.carp index 6d0ba14f4..e1ae9fe54 100644 --- a/test/regression.carp +++ b/test/regression.carp @@ -16,9 +16,9 @@ ; make sure nested lambdas don't break again (issue #342) (defn nested-lambdas [] - (let [f (fn [x] ((fn [y] (+ x y)) + (let [f (fn [x] (~(fn [y] (+ x y)) 1))] - (f 1))) + (~f 1))) ; make sure let bindings get updated in the right scope (defmacro let-and-set [] @@ -56,7 +56,7 @@ ;; defining function with def (not defn) (defn duplicate-arg [f] - (fn [x] (f x x))) + @(fn [x] (f x x))) (def double (duplicate-arg +)) @@ -89,7 +89,7 @@ (the (Map String AType) m)) ;; nested polymorphic types are resolved and emitted (#1293) -(defmodule Bar +(defmodule Bar (deftype (Baz a) [it a]) (deftype (Qux a) [it (Bar.Baz a)]) ) diff --git a/test/result.carp b/test/result.carp index 0750e1c54..4abbb242e 100644 --- a/test/result.carp +++ b/test/result.carp @@ -48,13 +48,13 @@ "map-error works with Error" ) (assert-true test - (error? &(and-then (Error @"hi") &(fn [x] (Success (Int.inc x))))) + (error? &(and-then (Error @"hi") (fn [x] (Success (Int.inc x))))) "and-then works with Error" ) (assert-equal test &(Success 2) &(and-then (the (Result Int String) (Success 1)) - &(fn [x] (Success (Int.inc x)))) + (fn [x] (Success (Int.inc x)))) "and-then works with Success" ) (assert-equal test @@ -70,23 +70,23 @@ (assert-equal test &(Error 5) &(or-else (the (Result Int String) (Error @"error")) - &(fn [x] (Error (String.length &x)))) + (fn [x] (Error (String.length &x)))) "or-else works with Error" ) (assert-equal test &(Success 1) - &(or-else (Success 1) &(fn [x] (Error (String.length &x)))) + &(or-else (Success 1) (fn [x] (Error (String.length &x)))) "or-else works with Success" ) (assert-equal test 5 (unwrap-or-else (the (Result Int String) (Error @"error")) - &(fn [s] (String.length &s))) + (fn [s] (String.length &s))) "unwrap-or-else works with Error" ) (assert-equal test 1 - (unwrap-or-else (Success 1) &(fn [s] (String.length &s))) + (unwrap-or-else (Success 1) (fn [s] (String.length &s))) "unwrap-or-else works with Success" ) (assert-equal test diff --git a/test/sort.carp b/test/sort.carp index b06e0487d..db223ed98 100644 --- a/test/sort.carp +++ b/test/sort.carp @@ -98,7 +98,7 @@ (let-do [arr [1 3 4 2 6 1] exp [6 4 3 2 1 1]] - (Array.sort-by! &arr &(fn [a b] (< a b))) + (Array.sort-by! &arr (fn [a b] (< a b))) (assert-equal test &exp &arr @@ -106,13 +106,13 @@ (let-do [arr [1 3 4 2 6 1] exp [6 4 3 2 1 1] - res (Array.sorted-by &arr &(fn [a b] (< a b)))] + res (Array.sorted-by &arr (fn [a b] (< a b)))] (assert-equal test &exp &res "Array.sorted-by works with custom functions")) - (let-do [res (Array.sort-by [1 3 4 2 6 1] &(fn [a b] (< a b))) + (let-do [res (Array.sort-by [1 3 4 2 6 1] (fn [a b] (< a b))) exp [6 4 3 2 1 1]] (assert-equal test &exp diff --git a/test/static_array.carp b/test/static_array.carp index e6cf67004..7e285abf7 100644 --- a/test/static_array.carp +++ b/test/static_array.carp @@ -8,7 +8,7 @@ (assert-equal test $[2 4 8] (do - (map! arr &(fn [val] (* @val 2))) + (map! arr (fn [val] (* @val 2))) arr) "map! works as expected")) @@ -50,7 +50,7 @@ 10 (let [arr $[2 2 2 2]] (reduce - &(fn [acc val] (+ acc @val)) + (fn [acc val] (+ acc @val)) 2 arr)) "reduce works as expected") @@ -67,40 +67,40 @@ (assert-equal test true - (any? &(fn [x] (= 0 @x)) $[0 1 2 3]) + (any? (fn [x] (= 0 @x)) $[0 1 2 3]) "any? works as expected I") (assert-equal test false - (any? &(fn [x] (= 0 @x)) $[1 2 3 4]) + (any? (fn [x] (= 0 @x)) $[1 2 3 4]) "any? works as expected II") (assert-equal test true - (all? &(fn [x] (< 0 @x)) $[1 2 3]) + (all? (fn [x] (< 0 @x)) $[1 2 3]) "all? works as expected I") (assert-equal test false - (all? &(fn [x] (< 0 @x)) $[0 1 2]) + (all? (fn [x] (< 0 @x)) $[0 1 2]) "all? works as expected II") (assert-equal test &(Maybe.Just 3) - &(find &(fn [x] (= 3 @x)) $[0 1 2 3]) + &(find (fn [x] (= 3 @x)) $[0 1 2 3]) "find works as expected I") (assert-nothing test - &(find &(fn [x] (= 4 @x)) $[0 1 2 3]) + &(find (fn [x] (= 4 @x)) $[0 1 2 3]) "find works as expected II") (assert-nothing test - &(find-index &(fn [i] (Int.even? @i)) $[1 3 5]) + &(find-index (fn [i] (Int.even? @i)) $[1 3 5]) "find-index works I") (assert-equal test &(Maybe.Just 1) - &(find-index &(fn [i] (Int.even? @i)) $[1 8 5]) + &(find-index (fn [i] (Int.even? @i)) $[1 8 5]) "find-index works II") (assert-equal test @@ -172,7 +172,7 @@ (assert-equal test 2 - (predicate-count $[1 8 5 10 3] &(fn [i] (Int.even? @i))) + (predicate-count $[1 8 5 10 3] (fn [i] (Int.even? @i))) "predicate-count works") (let [arr $[1 2]] diff --git a/test/test-for-errors/lambda_capturing_ref_that_dies.carp b/test/test-for-errors/lambda_capturing_ref_that_dies.carp index 520c888bd..c34e24fc1 100644 --- a/test/test-for-errors/lambda_capturing_ref_that_dies.carp +++ b/test/test-for-errors/lambda_capturing_ref_that_dies.carp @@ -3,6 +3,6 @@ (defn this-wont-work [] (let-do [s @"DATA" r &s - f (fn [] (IO.println r))] + f @(fn [] (IO.println r))] (delete s) (f)))