miloignis/kraken
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Finally make a clean sweep and delete / organize old files. Add skeleton for LaTeX formal writeup in doc/ and change license (since this is all new code from the past few years) to BSD-2-Clause-Patent

Browse Source
This commit is contained in:
Nathan Braswell
2022-01-30 16:57:21 -05:00
parent 315ae20698
commit 7f220c97b8
325 changed files with 901 additions and 31024 deletions
Download Patch File Download Diff File Expand all files Collapse all files

100
working_files/k_prime_stdlib/method.kp Normal file
View File

@@ -0,0 +1,100 @@
; 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)
(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)]))))
; Lambda syntax
(add_grammar_rule 'form ["\\|" 'optional_WS [ 'atom 'optional_WS ] * "\\|" 'optional_WS 'form ]
(lambda (_ _ params _ _ body) `(lambda (,(map (lambda (x) (idx x 0)) params)) ~body)))
; {} body translated to do and let
(add_grammar_rule 'block_member [ 'form ] |x| [x])
(add_grammar_rule 'block_member [ "let" 'optional_WS 'atom 'optional_WS "=" 'optional_WS 'form ]
|_ _ name _ _ _ rhs| `(~name ~rhs))
(fun construct_body (is_do current to_add i)
(if (> (len to_add) i)
(cond (and is_do (= (len (idx to_add i)) 1)) (construct_body true (concat current [(idx (idx to_add i) 0)]) to_add (+ i 1))
(= (len (idx to_add i)) 1) (concat current [(construct_body true [do (idx (idx to_add i) 0)] to_add (+ i 1))])
true (concat current [(construct_body false [let [(idx (idx to_add i) 0) (idx (idx to_add i) 1)] ] to_add (+ i 1))]))
current))
(add_grammar_rule 'form ["{" 'optional_WS [ 'block_member 'optional_WS ] * "}"]
|_ _ inner _| (construct_body true [do] (map |x| (idx x 0) inner) 0))
; Call functions with function first, c style (notice no whitespace)
(add_grammar_rule 'form [ 'form 'call_form ] |f ps| (concat [f] ps))
; fun syntax
(add_grammar_rule 'form [ "fun" 'WS 'atom 'optional_WS "\\(" 'optional_WS [ 'atom 'optional_WS ] * "\\)" 'optional_WS 'form ]
|_ _ name _ _ _ params _ _ body| `(fun ~name (,(map |x| (idx x 0) params)) ~body))
; string interpolation
fun remove_dollar(done to_do i j) (cond (>= j (- (len to_do) 2)) (str done (slice to_do i -1))
(= "\\$" (slice to_do j (+ j 2))) (remove_dollar (str done (slice to_do i j) "$") to_do (+ j 2) (+ j 2))
true (remove_dollar done to_do i (+ j 1)))
fun fixup_str_parts(s) (remove_dollar "" (slice s 0 -2) 0 0)
(add_grammar_rule 'form [ "$\"" [ "(#|[%-[]| |[]-~]|(\\\\)|(\\n)|(\\t)|(\\*)|(\\\\$)|
|[ -!]|(\\\\\"))*$" 'form ] * "(#|[%-[]| |[]-~]|(\\\\)|(\\n)|(\\t)|(\\*)|(\\\\$)|
|[ -!]|(\\\\\"))*\"" ]
|_ string_form_pairs end| `(str ,( flat_map |x| [ (fixup_str_parts (idx x 0)) (idx x 1) ] string_form_pairs) ~(fixup_str_parts end)))
(println $"unu |\$| $$"inner $(+ 1 2) post-inner" sual")
obj Point( x y ) {
add |self other| { Point((+ self.x other.x) (+ self.y other.y)) }
sub |self other| { Point((- self.x other.x) (- self.y other.y)) }
to_str |self| { str("x: " self.x ", y: " self.y) }
}
fun say_hi(name) {
println("hayo" name)
}
fun test() {
let plus_1 = |x| (+ x 1)
let a = 1
let b = plus_1(a)
println("some" b)
say_hi("Marcus")
let p1 = Point(1 2)
let p2 = Point(3 4)
let p3 = p1.add(p2)
let p4 = p1.sub(p2)
println("p1:" p1.to_str)
println("p2:" p2.to_str)
println("p3:" p3.to_str)
println("p4:" p4.to_str)
(+ a b)
}
println("Test result is" test())

82
working_files/k_prime_stdlib/prelude.kp Normal file
View File

@@ -0,0 +1,82 @@
(set! quote (vau _ (x) x))
(set! lambda (vau se (p b) (wrap (eval (array vau (quote _) p b) se))))
(set! current-env (vau de () de))
(set! fun (vau se (n p b) (eval (array set! n (array lambda p b)) se)))
; do_helper is basically mapping eval over statements, but the last one is in TCO position
; a bit of a hack, using cond to sequence (note the repitition of the eval in TCO position if it's last,
; otherwise the same eval in cond position, and wheather or not it returns a truthy value, it recurses in TCO position)
(fun do_helper (s i se) (cond (= i (len s)) nil
(= i (- (len s) 1)) (eval (idx s i) se)
(eval (idx s i) se) (do_helper s (+ i 1) se)
true (do_helper s (+ i 1) se)))
(set! do (vau se (& s) (do_helper s 0 se)))
(fun concat_helper (a1 a2 a3 i) (cond (< i (len a1)) (do (set-idx! a3 i (idx a1 i)) (concat_helper a1 a2 a3 (+ i 1)))
(< i (+ (len a1) (len a2))) (do (set-idx! a3 i (idx a2 (- i (len a1)))) (concat_helper a1 a2 a3 (+ i 1)))
true a3))
(fun concat (a1 a2) (concat_helper a1 a2 (array-with-len (+ (len a1) (len a2))) 0))
(add_grammar_rule (quote form) (quote ( "'" optional_WS form )) (vau de (_ _ f) (array quote (eval f de))))
(add_grammar_rule 'form '( "\\[" optional_WS space_forms optional_WS "\\]" ) (vau de (_ _ fs _ _) (concat (array array) (eval fs de))))
(fun vapply (f p ede) (eval (concat [f] p) ede))
(fun lapply (f p) (eval (concat [(unwrap f)] p) (current-env)))
(set! let1 (vau de (s v b) (eval [[vau '_ [s] b] (eval v de)] de)))
(set! let (vau de (vs b) (cond (= (len vs) 0) (eval b de) true (vapply let1 [(idx vs 0) (idx vs 1) [let (slice vs 2 -1) b]] de))))
(set! if (vau de (con than & else) (cond
(eval con de) (eval than de)
(> (len else) 0) (eval (idx else 0) de)
true nil)))
(fun map (f l)
(let (helper (lambda (f l n i recurse)
(if (= i (len l))
n
(do (set-idx! n i (f (idx l i)))
(recurse f l n (+ i 1) recurse)))))
(helper f l (array-with-len (len l)) 0 helper)))
(fun flat_map (f l)
(let (helper (lambda (f l n i recurse)
(if (= i (len l))
n
(recurse f l (concat n (f (idx l i))) (+ i 1) recurse))))
(helper f l (array) 0 helper)))
(fun map_with_idx (f l)
(let (helper (lambda (f l n i recurse)
(if (= i (len l))
n
(do (set-idx! n i (f i (idx l i)))
(recurse f l n (+ i 1) recurse)))))
(helper f l (array-with-len (len l)) 0 helper)))
(fun print_through (x) (do (println x) x))
(fun is_pair? (x) (and (array? x) (> (len x) 0)))
(set! quasiquote (vau de (x)
(cond (is_pair? x)
(cond (and (symbol? (idx x 0)) (= (get-text (idx x 0)) "unquote"))
(eval (idx x 1) de)
true
(cond (and (is_pair? (idx x 0)) (symbol? (idx (idx x 0) 0)) (= (get-text (idx (idx x 0) 0)) "splice-unquote"))
(concat (eval (idx (idx x 0) 1) de) (vapply quasiquote [(slice x 1 -1)] de))
true
(concat [(vapply quasiquote [(idx x 0)] de)] (vapply quasiquote [(slice x 1 -1)] de))))
true x)))
(add_grammar_rule 'form '("`" optional_WS form) (lambda (_ _ f) ['quasiquote f]))
(add_grammar_rule 'form '("~" optional_WS form) (lambda (_ _ f) ['unquote f]))
(add_grammar_rule 'form '("," optional_WS form) (lambda (_ _ f) ['splice-unquote f]))
(set! Y (lambda (f)
((lambda (x) (x x))
(lambda (x) (f (lambda (& y) (lapply (x x) y)))))))
(set! vY (lambda (f)
((lambda (x) (x x))
(lambda (x) (f (vau de (& y) (vapply (x x) y de)))))))
(set! rep (Y (lambda (recurse) (wrap (vau de ()
(do (println (eval (read-string (get_line "> ")) de)) (recurse)))))))