kraken/method.kp

; Load prelude so we get fun, lambda, if, quoting, etc
(load-file "./k_prime_stdlib/prelude.kp")
; First quick lookup function, since maps are not built in
(fun get-value-helper (dict key i) (if (>= i (len dict))
                                                nil
                                                (if (= key (idx dict i))
                                                    (idx dict (+ i 1))
                                                    (get-value-helper dict key (+ i 2)))))
(fun get-value (dict key) (get-value-helper dict key 0))

; Our actual method call function
(fun method-call (object method & arguments) (let (method_fn (get-value (meta object) method))
                                                            (if (= method_fn nil)
                                                                (println "no method " method)
                                                                (do (println "applying" method_fn (concat [object] arguments) ) (lapply method_fn (concat [object] arguments))))))
; Some nice syntactic sugar for method calls
(add_grammar_rule 'form ['form "\\." 'atom 'optional_WS "\\(" 'optional_WS 'space_forms 'optional_WS "\\)"]
                            (lambda (o _ m _ _ _ p _ _) `(method-call ~o '~m ,p)))

; Ok, let's create our object by hand for this example
(set! actual_obj (with-meta [0] [
                                'inc (lambda (o) (set-idx! o 0 (+ (idx o 0) 1)))
                                'dec (lambda (o) (set-idx! o 0 (- (idx o 0) 1)))
                                'set (lambda (o n) (set-idx! o 0 n))
                                'get (lambda (o) (idx o 0))
                                ]))
(do
    (println (meta actual_obj))
    ; Use our new sugar
    actual_obj.set(1337)
    actual_obj.inc()
    (println "get: " actual_obj.get())
    actual_obj.dec()
    (println "get: " actual_obj.get())

    ; Use methods directly
    (method-call actual_obj 'set 654)
    (method-call actual_obj 'inc)
    (println "get: " (method-call actual_obj 'get))
    (method-call actual_obj 'dec)
    (method-call actual_obj 'dec)
    (println "get: " (method-call actual_obj 'get))

    nil)