mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-11 05:25:28 +03:00
eb85906e52
* Meta: Fix hangs on calls to meta functions This commit fixes a subtle bug whereby setting the meta of an existing binder would cause hangs. Ultimately, this still points to an underlying issue in our Lookup code that causes such loops, but for now this at least fixes the hang introduced by the doc call in `core/Tuples.carp` (see issue #842). The primary fix seems to be related to setting the parentEnv in a case in which we failed to do so in `Eval.hs`. Additionally, our meta setting macros call `eval` which causes them to be evaluated *immediately after* expansion, causing them to be evaluated in the incorrect context in the Tuples.carp case. Additionally: - Refactored primitiveMetaSet and primitiveMeta to make them cleaner. - Only set `implements` early when we're certain we won't accidentally overwrite the interface. - Generalize DocStub to `MetaStub` so that it may be used for forward meta declarations of any kind. * Macros: Don't eval meta-set! macros Calling eval in the body of the meta-set! macros can cause them to be evaluated before anticipated, possibly setting the meta on a binding in the incorrect environment. An exemplary case of this issue existed in `Tuples.carp` (also fixed in this commit) whereby the generated defmodule for a tuple type called doc, which was evaluated *before* the emitted module, resulting in overwrites of global name docs instead of the expected module function. We retain `evals` in macros that are more useful in the repl, such as `print-doc`. If a user wants to evaluated one of the meta-set macros in the REPL, they'll need to add a call to eval. * Macros: Restore calls to eval Turns out the meta-set! macros *do* require calls to eval, unlike I reported in the previous commit. This commit restores those and replaces the `doc` call in `Tuples.carp` with a direct `meta-set!` to ensure we have docs for those functions. Also fixed a small error in implements primitive. * Primitives: Refactor i->inner in primitiveImplements
96 lines
3.5 KiB
Plaintext
96 lines
3.5 KiB
Plaintext
(defmodule Dynamic
|
|
(private deftuple-type-)
|
|
(hidden deftuple-type-)
|
|
(defndynamic deftuple-type- [name props]
|
|
(list 'deftype (cons name props)
|
|
(collect-into (flatten (map (fn [x] (list x x)) props)) array)))
|
|
|
|
(private deftuple-lt-)
|
|
(hidden deftuple-lt-)
|
|
(defndynamic deftuple-lt- [name props]
|
|
(if (empty? props)
|
|
'false
|
|
(let [fst (Symbol.prefix name (car props))]
|
|
(if (= (length props) 1)
|
|
(list '< (list fst 't1) (list fst 't2))
|
|
(list 'if (list '= (list fst 't1) (list fst 't2))
|
|
(deftuple-lt- name (cdr props))
|
|
(list '< (list fst 't1) (list fst 't2)))))))
|
|
|
|
; this is basically just a giant template
|
|
(private deftuple-module-)
|
|
(hidden deftuple-module-)
|
|
(defndynamic deftuple-module- [name props]
|
|
(let [sname (Symbol.str name)
|
|
module-name (Symbol.concat [name 'Ref])]
|
|
(list 'do
|
|
(list 'defmodule module-name
|
|
(list 'defn '= ['t1 't2]
|
|
(cons 'and*
|
|
(map (fn [p]
|
|
(list '=
|
|
(list (Symbol.prefix name p) 't1)
|
|
(list (Symbol.prefix name p) 't2)))
|
|
props)))
|
|
(list 'implements '= (Symbol.prefix module-name '=))
|
|
|
|
(list 'defn '< ['t1 't2] (deftuple-lt- name props))
|
|
(list 'implements '< (Symbol.prefix module-name '<))
|
|
|
|
(list 'defn '> ['t1 't2] (list (Symbol.prefix module-name '<) 't2 't1))
|
|
(list 'implements '> (Symbol.prefix module-name '>)))
|
|
|
|
(list 'defmodule name
|
|
(list 'doc 'init-from-refs
|
|
(String.concat ["initializes a `" sname "` from member references."]))
|
|
(let [prop-vars (map (fn [x] (Symbol.concat [x '-val])) props)]
|
|
(list 'defn 'init-from-refs (collect-into prop-vars array)
|
|
(cons 'init (map (fn [x] (list 'copy x)) prop-vars))))
|
|
|
|
(list 'defn '= ['t1 't2]
|
|
(cons 'and*
|
|
(map (fn [p] (list '= (list p '(ref t1)) (list p '(ref t2)))) props)))
|
|
(list 'implements '= (Symbol.prefix name '=))
|
|
|
|
(list 'defn '< ['t1 't2]
|
|
(list (Symbol.prefix module-name '<) '(ref t1) '(ref t2)))
|
|
(list 'implements '< (Symbol.prefix name '<))
|
|
|
|
(list 'defn '> ['t1 't2]
|
|
(list (Symbol.prefix module-name '>) '(ref t1) '(ref t2)))
|
|
(list 'implements '> (Symbol.prefix name '>))
|
|
|
|
(list 'doc 'reverse
|
|
(String.concat ["reverses a `" sname "` by reversing its member positions."]))
|
|
(list 'defn 'reverse ['t]
|
|
(cons 'init (map (fn [x] (list 'copy (list x 't))) (reverse props))))
|
|
|
|
(list 'meta-set! 'zero "doc"
|
|
(String.concat [
|
|
"initializes a `" sname
|
|
"` by calling `zero` for all its members. `zero` must be defined for all member types."]))
|
|
(list 'defn 'zero [] (cons 'init (map (fn [_] '(zero)) props))))
|
|
(list 'implements 'zero (Symbol.prefix name 'zero))
|
|
)))
|
|
|
|
(doc deftuple "defines a tuple type.
|
|
|
|
For example:
|
|
```
|
|
; is the definition of Pair in the stdlib
|
|
(deftuple Pair a b)
|
|
```")
|
|
(defmacro deftuple [name :rest props]
|
|
(do
|
|
(eval (deftuple-type- name props))
|
|
(eval (deftuple-module- name props))
|
|
))
|
|
)
|
|
|
|
(doc Pair "is a 2-tuple, i.e. a datatype with two members.")
|
|
(deftuple Pair a b)
|
|
(doc Triple "is a 3-tuple, i.e. a datatype with three members.")
|
|
(deftuple Triple a b c)
|
|
(doc Quadruple "is a 4-tuple, i.e. a datatype with four members.")
|
|
(deftuple Quadruple a b c d)
|