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 [