diff --git a/k_prime.krak b/k_prime.krak index ef920cd..7de5742 100644 --- a/k_prime.krak +++ b/k_prime.krak @@ -1162,6 +1162,29 @@ fun main(argc: int, argv: **char): int { return make_pair(null(), unwrap(params[0])) })); + env->set(str("error"), make_builtin_combiner(str("error"), 1, false, fun(params: vec, dynamic_env: *KPEnv): pair<*KPEnv, KPResult> { + if params.size != 1 { + return make_pair(null(), KPResult::Err(kpString(str("error called with not one argument")))) + } + return make_pair(null(), KPResult::Err(params[0])) + })); + + env->set(str("recover"), make_builtin_combiner(str("recover"), 0, false, fun(params: vec, dynamic_env: *KPEnv): pair<*KPEnv, KPResult> { + if params.size != 3 { + return make_pair(null(), KPResult::Err(kpString(str("recover called with not three arguments")))) + } + var data = EVAL(dynamic_env, params[0]) + if is_err(data) { + if !params[1].is_symbol() { + return make_pair(null(), KPResult::Err(kpString(str("recover called with not symbol as middle")))) + } + var new_env = new()->construct(dynamic_env) + new_env->set(params[1].get_symbol_text(), get_err(data)) + return make_pair(null(), EVAL(new_env, params[2])) + } + return make_pair(null(), data) + })); + var add_grammer_rule_helper: fun(ref Grammer, str, vec, KPValue, fun(ref KPValue, ref vec): KPResult): KPResult = fun(grammar: ref Grammer, nonterminal_str: str, rule: vec, data: KPValue, f: fun(ref KPValue, ref vec): KPResult): KPResult { var int_rule = vec() for (var i = 0; i < rule.size; i++;) { diff --git a/new_kraken.kp b/new_kraken.kp index 403c55a..14dc5e7 100644 --- a/new_kraken.kp +++ b/new_kraken.kp @@ -40,53 +40,58 @@ - new_kraken_untyped (concat standard_grammar (array + new_kraken_untyped (concat basic_rules [ - (array 'call_innards [ 'WS * ] (lambda (_) (array))) - (array 'call_innards [ 'form [ 'WS 'form ] * ] (lambda (f r) (concat [f] (map (lambda (x) (idx x 1)) r)))) + [ 'expr [ 'number ] (lambda (x) x) ] + [ 'expr [ 'string ] (lambda (x) x) ] + [ 'expr [ 'bool_nil_symbol ] (lambda (x) x) ] - (array 'form ['form "\\." 'atom] - (lambda (o _ m) `(~method-call ~o '~m))) + [ 'call_innards [ 'WS * ] (lambda (_) []) ] + [ 'call_innards [ 'expr [ 'WS 'expr ] * ] (lambda (f r) (concat [f] (map (lambda (x) (idx x 1)) r))) ] + + [ 'expr ['expr "\\." 'bool_nil_symbol] (lambda (o _ m) `(~method-call ~o '~m)) ] ; params - (array 'form ['form "\\." 'atom "\\(" 'call_innards "\\)"] - (lambda (o _ m _ p _) `(~method-call ~o '~m ,p))) + [ 'expr ['expr "\\." 'bool_nil_symbol "\\(" 'call_innards "\\)"] + (lambda (o _ m _ p _) `(~method-call ~o '~m ,p)) ] - (array 'form [ "\\|" 'call_innards "\\|" 'WS * 'form ] - (lambda (_ params _ _ body) `(lambda (,params) ~body))) + [ 'expr [ "\\|" 'call_innards "\\|" 'WS * 'expr ] + (lambda (_ params _ _ body) `(lambda (,params) ~body)) ] ; Call functions with function first, c style (notice no whitespace) - (array 'form [ 'form "\\(" 'call_innards "\\)" ] - (lambda (f _ ps _) (concat [f] ps))) + [ 'expr [ 'expr "\\(" 'call_innards "\\)" ] + (lambda (f _ ps _) (concat [f] ps)) ] ; fun syntax - (array 'block_member [ "fun" 'WS 'atom 'WS * "\\(" 'call_innards "\\)" 'WS * 'form ] - (lambda (_ _ name _ _ params _ _ body) `(~name (~lambda (,params) ~body)))) + [ 'block_member [ "fun" 'WS 'bool_nil_symbol 'WS * "\\(" 'call_innards "\\)" 'WS * 'expr ] + (lambda (_ _ name _ _ params _ _ body) `(~name (~lambda (,params) ~body))) ] - (array 'block_member [ 'form ] (lambda (x) [x])) - (array 'block_member [ "let" 'WS * 'atom 'WS * "=" 'WS * 'form ] - (lambda (_ _ name _ _ _ rhs) `(~name ~rhs))) + [ 'block_member [ 'expr ] (lambda (x) [x]) ] + [ 'block_member [ "let" 'WS * 'bool_nil_symbol 'WS * "=" 'WS * 'expr ] + (lambda (_ _ name _ _ _ rhs) `(~name ~rhs)) ] ; object syntax - (array 'block_member ["obj" 'WS 'atom "\\(" ['WS * 'atom] * 'WS * "\\)" 'WS * "{" 'WS * ['atom 'WS * 'form 'WS *] * "}"] + [ 'block_member ["obj" 'WS 'bool_nil_symbol "\\(" ['WS * 'bool_nil_symbol] * 'WS * "\\)" 'WS * "{" 'WS * ['bool_nil_symbol 'WS * 'expr 'WS *] * "}"] (lambda (_ _ name _ members _ _ _ _ _ methods _) [name (make_constructor name (map (lambda (x) (idx x 1)) members) - (map (lambda (x) [(idx x 0) (idx x 2)]) methods))])) + (map (lambda (x) [(idx x 0) (idx x 2)]) methods))]) ] ; import - (array 'block_member [ "with_import" 'WS 'atom 'WS * ":" ] - (lambda (_ _ file _ _) [file 0 0])) + [ 'block_member [ "with_import" 'WS 'string 'WS * ":" ] + (lambda (_ _ file _ _) [file 0 0]) ] - (array 'form ["{" 'WS * [ 'block_member 'WS ] * "}"] - (lambda (_ _ inner _) (construct_body true [do] (map (lambda (x) (idx x 0)) inner) 0))) + [ 'expr ["{" 'WS * 'block_member "}"] + (lambda (_ _ inner _) (construct_body true [do] [inner] 0)) ] + [ 'expr ["{" 'WS * [ 'block_member 'WS ] * "}"] + (lambda (_ _ inner _) (construct_body true [do] (map (lambda (x) (idx x 0)) inner) 0)) ] - (array 'new_kraken_start_symbol [ 'WS * [ 'block_member 'WS ] * ] - (lambda (_ inner) (construct_body true [do] (map (lambda (x) (idx x 0)) inner) 0))) + [ 'new_kraken_start_symbol [ 'WS * [ 'block_member 'WS ] * ] + (lambda (_ inner) (construct_body true [do] (map (lambda (x) (idx x 0)) inner) 0)) ] - (array 'form [ "$\"" [ "(#|[%-[]| |[]-~]|(\\\\)|(\\n)|(\\t)|(\\*)|(\\\\$)| -|[ -!]|(\\\\\"))*$" 'form ] * "(#|[%-[]| |[]-~]|(\\\\)|(\\n)|(\\t)|(\\*)|(\\\\$)| + [ 'expr [ "$\"" [ "(#|[%-[]| |[]-~]|(\\\\)|(\\n)|(\\t)|(\\*)|(\\\\$)| +|[ -!]|(\\\\\"))*$" 'expr ] * "(#|[%-[]| |[]-~]|(\\\\)|(\\n)|(\\t)|(\\*)|(\\\\$)| |[ -!]|(\\\\\"))*\"" ] - (lambda (_ string_form_pairs end) `(str ,( flat_map (lambda (x) [ (fixup_str_parts (idx x 0)) (idx x 1) ]) string_form_pairs) ~(fixup_str_parts end)))) + (lambda (_ string_expr_pairs end) `(str ,( flat_map (lambda (x) [ (fixup_str_parts (idx x 0)) (idx x 1) ]) string_expr_pairs) ~(fixup_str_parts end))) ] - ))) + ])) (provide new_kraken_untyped) ) diff --git a/new_kraken_test.kp b/new_kraken_test.kp index a7c2c8e..11bae59 100644 --- a/new_kraken_test.kp +++ b/new_kraken_test.kp @@ -1,11 +1,11 @@ #lang (with_import "./new_kraken.kp" new_kraken_untyped) new_kraken_start_symbol let my_var = 1337 -(println $"this is string interpolation: $(+ 1 3 4) <- cool right? another $my_var yep even variables") +println($"this is string interpolation: ${+(1 3 4)} <- cool right? another $my_var yep even variables") 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)) } + 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) } } @@ -14,7 +14,7 @@ fun say_hi(name) { } fun test() { - let plus_1 = |x| (+ x 1) + let plus_1 = |x| { +(x 1) } let a = 1 let b = plus_1(a) println("some" b) @@ -32,10 +32,10 @@ fun test() { println("p3:" p3.to_str) println("p4:" p4.to_str) - println("before + a b" (+ a b)) - (with_import "./import_test.kp" (println "after + a b" (+ a b))) - println("post after + a b" (+ a b)) + println("before + a b" +(a b)) + with_import("./import_test.kp" println("after + a b" +(a b))) + println("post after + a b" +(a b)) with_import "./import_test.kp": - println("post new impot after + a b" (+ a b)) + println("post new impot after + a b" +(a b)) } println("Test result is" test()) diff --git a/prelude.kp b/prelude.kp index e997f84..aa48f4d 100644 --- a/prelude.kp +++ b/prelude.kp @@ -122,33 +122,13 @@ true (concat (array (vapply recurse (array (idx x 0)) de)) (vapply recurse (array (slice x 1 -1)) de)))) true x)))) - provide (vau de (& items) (array let - (flat_map (lambda (item) (array item (array quote (eval item de)))) items))) - scope_let_sans_import_gram ( - provide - root_env - lambda - rec-lambda - let - let-rec - let-vrec - do - if - concat - map - flat_map - map_with_idx - lapply - vapply - Y - vY - Y* - quote - quasiquote - provide - print_through - ) - insert_into_scope_let (lambda (scope_let name item) (array (idx scope_let 0) (concat (idx scope_let 1) (array name (array quote item))))) + + repl (vY (lambda (recurse) (wrap (vau de (grammer start_symbol) + (do (recover (println (eval (read-string (get_line "> ") grammer start_symbol) de)) + captured_error (println "repl caught an exception:" captured_error)) + (eval (array recurse (array quote grammer) (array quote start_symbol)) de)))))) + + string-to-int (lambda (s) (let ( helper (rec-lambda recurse (s i result) (if (< i (len s)) @@ -176,6 +156,48 @@ ) )) (helper s 1 ""))) + basic_rules (array + (array (quote WS) (array "( | | +|(;[ -~]* +))+") (lambda (x) nil)) + (array (quote number) (array "-?[0-9]+") (lambda (x) (string-to-int x))) + (array (quote string) (array "\"([#-[]| |[]-~]|(\\\\\\\\)|(\\\\n)|(\\\\t)|(\\*)|(\\\\0)| +|[ -!]|(\\\\\"))*\"") (lambda (x) (unescape-str x))) + (array (quote bool_nil_symbol) (array "-|(([a-z]|[A-Z]|_|\\*|/|\\?|\\+|!|=|&|<|>|%)([a-z]|[A-Z]|_|[0-9]|\\*|\\?|\\+|-|!|=|&|<|>|%)*)") (lambda (x) (cond (= "true" x) true + (= "false" x) false + (= "nil" x) nil + true (str-to-symbol x)))) + ) + + provide (vau de (& items) (array let + (flat_map (lambda (item) (array item (array quote (eval item de)))) items))) + scope_let_sans_import_gram (provide + root_env + lambda + rec-lambda + let + let-rec + let-vrec + do + if + concat + map + flat_map + map_with_idx + lapply + vapply + Y + vY + Y* + quote + quasiquote + repl + provide + print_through + basic_rules + ) + insert_into_scope_let (lambda (scope_let name item) (array (idx scope_let 0) (concat (idx scope_let 1) (array name (array quote item))))) + scope_let (let-vrec ( with_import (vau de (lib_path code) (let (imported_scope_let (eval (concat @@ -184,18 +206,10 @@ (quote with_import) with_import) (array (read-string (slurp (eval lib_path de)) (gen_standard_grammar) (quote start_symbol)))) root_env)) (eval (concat imported_scope_let (array code)) de))) - gen_standard_grammar (vau de () (array - (array (quote WS) (array "( | | -|(;[ -~]* -))+") (lambda (x) nil)) - (array (quote atom) (array "-?[0-9]+") (lambda (x) (string-to-int x))) - (array (quote atom) (array "\"([#-[]| |[]-~]|(\\\\\\\\)|(\\\\n)|(\\\\t)|(\\*)|(\\\\0)| -|[ -!]|(\\\\\"))*\"") (lambda (x) (unescape-str x))) - (array (quote atom) (array "-|(([a-z]|[A-Z]|_|\\*|/|\\?|\\+|!|=|&|<|>|%)([a-z]|[A-Z]|_|[0-9]|\\*|\\?|\\+|-|!|=|&|<|>|%)*)") (lambda (x) (cond (= "true" x) true - (= "false" x) false - (= "nil" x) nil - true (str-to-symbol x)))) - (array (quote form) (array (quote atom)) (lambda (x) x)) + gen_standard_grammar (vau de () (concat basic_rules (array + (array (quote form) (array (quote number)) (lambda (x) x)) + (array (quote form) (array (quote string)) (lambda (x) x)) + (array (quote form) (array (quote bool_nil_symbol)) (lambda (x) x)) (array (quote form) (array "\\(" (quote WS) * "\\)" ) (lambda (_ _ _) (array))) (array (quote form) (array "\\(" (quote WS) * (quote form) (array (quote WS) + (quote form)) * (quote WS) * "\\)" ) (lambda (_ _ head tail _ _) (concat (array head) (map (lambda (x) (idx x 1)) tail)))) @@ -215,23 +229,20 @@ (quote with_import) with_import) (array gram)) root_env) symbol)))) - )) + ))) ) (insert_into_scope_let (insert_into_scope_let scope_let_sans_import_gram (quote standard_grammar) (gen_standard_grammar)) (quote with_import) with_import) ) standard_grammar (eval (concat scope_let (array (quote standard_grammar))) root_env) - - rep (vY (lambda (recurse) (wrap (vau de () (do (println (eval (read-string (get_line "> ") standard_grammar (quote start_symbol)) de)) - (eval (array recurse) de)))))) ) (do (println "Welcome to Kraken! Parameters were" *ARGV*) (cond (and (>= (len *ARGV*) 3) (= "-C" (idx *ARGV* 1))) (eval (concat scope_let (array (read-string (idx *ARGV* 2) standard_grammar (quote start_symbol)))) root_env) (> (len *ARGV*) 1) (eval (concat scope_let (array (read-string (slurp (idx *ARGV* 1)) standard_grammar (quote start_symbol)))) root_env) - true (eval (concat scope_let (array (array rep))) root_env) + true (eval (concat scope_let (array (array repl (array quote standard_grammar) (array quote (quote start_symbol))))) root_env) ) ) )