kraken/method.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 (idx dict i) 0))
                                                    (idx (idx dict i) 1)
                                                    (get-value-helper dict key (+ i 1)))))
(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
; No params
(add_grammar_rule 'form ['form "\\." 'atom]
                            (lambda (o _ m) `(method-call ~o '~m)))
; params
(add_grammar_rule 'form ['form "\\." 'atom 'optional_WS "\\(" 'optional_WS 'space_forms 'optional_WS "\\)"]
                            (lambda (o _ m _ _ _ p _ _) `(method-call ~o '~m ,p)))

; object creation
(fun make_constructor (members methods)
    (eval `(lambda  ~members
        (with-meta [,members]
            [,(map_with_idx (lambda (i x) [array `'~x (lambda (o) (idx o i))]) members)
             ,(map (lambda (x) [array `'~(idx x 0) (idx x 1)]) methods)]))))

; object syntax
(add_grammar_rule 'form ["obj" 'WS 'atom "\\(" ['optional_WS 'atom] * 'optional_WS "\\)" 'optional_WS "{" 'optional_WS ['atom 'optional_WS 'form 'optional_WS] *  "}"] (lambda (_ _ name _ members _ _ _ _ _ methods _)
        `(set! ~name (make_constructor [,(map (lambda (x) `'~(idx x 1)) members)]
                                       [,(map (lambda (x) `['~(idx x 0) ~(idx x 2)]) methods)]))))

; 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))]
                                ]))

(println "asdf")
(let (
      MyConstructor (make_constructor '( a b c ) [ ['sum (lambda (o) (+ o.a o.b o.c))]
                                                   ['add_a (lambda (o c) (+ o.a c))]])
      my_object (MyConstructor 1 2 3)
     )
    (do
        (println MyConstructor)
        (println my_object)
        (println my_object.a)
        (println my_object.b)
        (println my_object.c)
        (println my_object.sum)
        (println my_object.add_a(12))
    ))
(println "fdsa")

obj MyConstructor() {}
(println '(obj MyConstructor() {}))
(println MyConstructor)
(println (MyConstructor))

(println "done with first")

(println '(obj MyConstructor2( mem1 mem2 ) {}))

obj MyConstructor2( mem1 mem2 ) {
    add (lambda (self & nums) (lapply + (concat [self.mem1 self.mem2] nums)))
    sub (lambda (self & nums) (lapply - (concat [self.mem1 self.mem2] nums)))
}
(println "made")
(println MyConstructor2)
(println (MyConstructor2 1 2))
(println (meta (MyConstructor2 1 2)))
(println "it will be " (MyConstructor2 1337 266).mem1())
(println "it will be " (MyConstructor2 1337 266).mem2())
(println "it will be " (MyConstructor2 1337 777).mem2)
(println "it will be " (MyConstructor2 1337 777).add)
(println "it will be " (MyConstructor2 1337 777).add(1))
(println "it will be " (MyConstructor2 1337 777).add(1 2))
(println "it will be " (MyConstructor2 1337 777).sub(1 2))
(println "it was")

(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)