Last active
February 22, 2020 10:38
-
-
Save antonhornquist/6c049cb84718d70bd94fcd958c65db81 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| ( | |
| // an ad-hoc, informally-specified, bug-ridden, slow implementation of half of Common Lisp. | |
| /* | |
| TODO: assoc / assv / assq TODO | |
| TODO: (sc only) suspicion that slow ss_* functions has performance penalty - check by testing parsed statements in define_non_prim_standard_procedures | |
| TODO: (sc only) for clarity, use .value() over .() | |
| */ | |
| /* | |
| inspiration: | |
| https://norvig.com/lispy.html | |
| scheme r4rs @ https://people.csail.mit.edu/jaffer/r4rs_toc.html | |
| TODO r4rs defines 146 essential procedures excluding additional car/cdr permutations | |
| a few differences to r4rs: | |
| no support for macros (macros are not required in r4rs) | |
| no TCO yet | |
| symbol case is significant | |
| strings are immutable | |
| quasiquote does not support nesting | |
| */ | |
| // TODO: turn on function inline hints! | |
| /* | |
| LanguageConfig.postInlineWarnings_(true); | |
| */ | |
| var | |
| run_tests = { | |
| currentEnvironment['_NS_ENV'] = (); | |
| init_ns_environment.(currentEnvironment['_NS_ENV']); | |
| // run_rep_tests1(); | |
| // run_rep_tests2(); | |
| // run_rep_tests3(); | |
| ss_test.(); | |
| ss_as_string_test.(); | |
| // read_test(); | |
| }; | |
| var | |
| ss_test = { | |
| var s; | |
| s = ss_new.("This is an example string"); | |
| assert_equal.( "This", ss_scan.(s, "\\w+") ); | |
| assert_equal.( nil, ss_scan.(s, "\\w+") ); | |
| assert_equal.( " ", ss_scan.(s, "\\s+") ); | |
| assert_equal.( nil, ss_scan.(s, "\\s+") ); | |
| assert_equal.( "is", ss_scan.(s, "\\w+") ); | |
| assert_false.( ss_eos.(s) ); | |
| assert_equal.( " ", ss_scan.(s, "\\s+") ); | |
| assert_equal.( "an", ss_scan.(s, "\\w+") ); | |
| assert_equal.( " ", ss_scan.(s, "\\s+") ); | |
| assert_equal.( "example", ss_scan.(s, "\\w+") ); | |
| assert_equal.( " ", ss_scan.(s, "\\s+") ); | |
| assert_equal.( "string", ss_scan.(s, "\\w+") ); | |
| assert_true.( ss_eos.(s) ); | |
| assert_equal.( nil, ss_scan.(s, "\\w+") ); | |
| assert_equal.( nil, ss_scan.(s, "\\s+") ); | |
| }; | |
| var | |
| ss_as_string_test = { | |
| var abc = ss_new.("test string 42134"); | |
| assert_equal.("StringScanner 0/17 @ \"test string 42134\"", ss_as_string.(abc)); | |
| assert_equal.(4, ss_matches.(abc, "\\S+")); | |
| assert_equal.("StringScanner 0/17 @ \"test string 42134\"", ss_as_string.(abc)); | |
| ss_skip.(abc, "\\S+"); | |
| assert_equal.("StringScanner 4/17 \"test\" @ \" string 42134\"", ss_as_string.(abc)); | |
| }; | |
| /* | |
| repl | |
| */ | |
| var | |
| repl = | |
| { | |
| var cmd_period_preprocessor_key = '*cmdperiod-is-preprocessor-toggle*'; | |
| var enable_pre_processor = { | |
| // TODO var funcName = 'enable_pre_processor'; | |
| this.preProcessor = { |code, interpreter| "e.val(\""++code.escapeChar($")++"\");" }; | |
| "lisp preprocessor enabled!".inform; | |
| }; | |
| var disable_pre_processor = { | |
| // TODO var funcName = 'disable_pre_processor'; | |
| this.preProcessor = nil; | |
| "lisp preprocessor disabled".inform; | |
| }; | |
| currentEnvironment['_NS_ENV'] = nil; | |
| init_ns_environment.value(currentEnvironment); | |
| e = e ? (); | |
| e['val'] = { |self, str, env| rep.value(str, env) }; | |
| if (CmdPeriod.objects.includes(e.cmdPeriodHook)) { | |
| CmdPeriod.remove(e.cmdPeriodHook) | |
| }; | |
| e['cmdPeriod'] = e['cmdPeriod'] ? { | |
| if (currentEnvironment[cmd_period_preprocessor_key].asBoolean) { | |
| if (this.preProcessor.notNil) { | |
| disable_pre_processor.value | |
| } { | |
| enable_pre_processor.value; | |
| }; | |
| }; | |
| }; | |
| CmdPeriod.add(e['cmdPeriod']); | |
| currentEnvironment[cmd_period_preprocessor_key] = true; | |
| currentEnvironment['enable-ns-preprocessor'] = enable_pre_processor; | |
| currentEnvironment['disable-ns-preprocessor'] = disable_pre_processor; | |
| "interpreter variable e is used".warn; | |
| "e.val(\"(+ 1 2)\"); // to interpret a lisp expression in the sclang interpreter".inform; | |
| "currentEnvironment['*cmdperiod-is-preprocessor-toggle*'] = true; // if set to true cmdPeriod will toggle lisp preprocessor enabled/disabled (default is true)".inform; | |
| enable_pre_processor.value; | |
| }; | |
| var | |
| rep = | |
| { |str, env| | |
| // TODO var funcName = 'rep'; | |
| var val = read_eval.value(str, env ? currentEnvironment['_NS_ENV'] ? currentEnvironment); | |
| if (val.notNil) { | |
| scheme_str.value(val); | |
| }; | |
| }; | |
| /* | |
| read / eval | |
| */ | |
| var | |
| read_eval = | |
| { |str, env| | |
| eval.value(read.value(str), env); | |
| }; | |
| var | |
| init_ns_environment = | |
| { |dest_env| | |
| var environment = (); | |
| environment putAll: standard_procedures.value; | |
| environment putAll: additional_procedures.value; | |
| dest_env putAll: environment; | |
| }; | |
| var | |
| standard_procedures = | |
| { | |
| // TODO var funcName = 'standard_procedures'; | |
| var procedures = ( | |
| // r4rs essential procedure: (= z1 z2 z3 ...) TODO: varargs | |
| '=': { |a, b| | |
| a.asFloat == b.asFloat // TODO | |
| }, | |
| // r4rs essential procedure: (< z1 z2 z3 ...) TODO: varargs | |
| '<': { |a, b| | |
| a < b | |
| }, | |
| // r4rs essential procedure: (> z1 z2 z3 ...) TODO: varargs | |
| '>': { |a, b| | |
| a > b | |
| }, | |
| // r4rs essential procedure: (<= z1 z2 z3 ...) TODO: varargs | |
| '<=': { |a, b| | |
| a <= b | |
| }, | |
| // r4rs essential procedure: (>= z1 z2 z3 ...) TODO: varargs | |
| '>=': { |a, b| | |
| a >= b | |
| }, | |
| // r4rs essential procedure: (+ z1 ...) TODO: varargs | |
| '+': { |a, b| | |
| a + b | |
| }, | |
| // r4rs essential procedure: (* z1 ...) TODO: varargs | |
| '*': { |a, b| | |
| a * b | |
| }, | |
| // r4rs essential procedure: (- z1 z2) | |
| // r4rs essential procedure: (- z) TODO | |
| // r4rs procedure: (- z1 z2 ...) TODO | |
| '-': { |a, b| | |
| a - b | |
| }, | |
| // r4rs essential procedure: (/ z1 z2) | |
| // r4rs essential procedure: (/ z) TODO | |
| // r4rs procedure: (/ z1 z2 ...) TODO | |
| '/': { |a, b| | |
| a / b | |
| }, | |
| // r4rs essential procedure: (abs x) | |
| 'abs': { |x| | |
| x.abs | |
| }, | |
| // r4rs essential procedure: (append list ...) | |
| 'append': { |... lists| | |
| var result = []; | |
| lists.do { |list| | |
| if (is_list.value(list).not) { | |
| Error("not a list: %".format(scheme_str.value(list))).throw; | |
| }; | |
| result = result.addAll(list) | |
| }; | |
| result | |
| }, | |
| // r4rs essential procedure: (apply proc args) | |
| // r4rs procedure: (apply proc arg1 ... args) | |
| 'apply': { |proc, args| | |
| Error("TODO: apply").throw; | |
| }, | |
| // r4rs essential procedure: (boolean? obj) | |
| 'boolean?': { |obj| | |
| is_boolean(obj) | |
| }, | |
| // r4rs essential procedure: (call-with-current-continuation proc) | |
| 'call-with-current-continuation': { |proc| | |
| Error("TODO: call-with-current-continuation").throw; | |
| }, | |
| // r4rs essential procedure: (call-with-input-file string proc) | |
| 'call-with-input-file': { |string, proc| | |
| Error("TODO: call-with-input-file").throw; | |
| }, | |
| // r4rs essential procedure: (call-with-output-file string proc) | |
| 'call-with-output-file': { |string, proc| | |
| Error("TODO: call-with-output-file").throw; | |
| }, | |
| // r4rs essential procedure: (close-input-port port) | |
| 'close-input-port': { |port| | |
| Error("TODO: close-input-port").throw; | |
| }, | |
| // r4rs essential procedure: (close-output-port port) | |
| 'close-output-port': { |port| | |
| Error("TODO: close-output-port").throw; | |
| }, | |
| // r4rs essential procedure: (current-input-port) | |
| 'current-input-port': { | |
| Error("TODO: current-input-port").throw; | |
| }, | |
| // r4rs essential procedure: (current-output-port) | |
| 'current-output-port': { | |
| Error("TODO: current-output-port").throw; | |
| }, | |
| // r4rs essential procedure: (char? obj) | |
| 'char?': { |obj| | |
| is_chr.value(obj) | |
| }, | |
| // r4rs essential procedure: (char=? char1 char2) | |
| 'char=?': { |char1, char2| | |
| is_chr.value(char1) and: is_chr.value(char2) and: (char1 == char2) | |
| }, | |
| // r4rs essential procedure: (char<? char1 char2) | |
| 'char<?': { |char1, char2| | |
| is_chr.value(char1) and: is_chr.value(char2) and: (char1 < char2) | |
| }, | |
| // r4rs essential procedure: (char>? char1 char2) | |
| 'char>?': { |char1, char2| | |
| is_chr.value(char1) and: is_chr.value(char2) and: (char1 > char2) | |
| }, | |
| // r4rs essential procedure: (char<=? char1 char2) | |
| 'char<=?': { |char1, char2| | |
| is_chr.value(char1) and: is_chr.value(char2) and: (char1 <= char2) | |
| }, | |
| // r4rs essential procedure: (char>=? char1 char2) | |
| 'char>=?': { |char1, char2| | |
| is_chr.value(char1) and: is_chr.value(char2) and: (char1 >= char2) | |
| }, | |
| // r4rs essential procedure: (char-ci=? char1 char2) | |
| 'char-ci=?': { |char1, char2| | |
| is_chr.value(char1) and: is_chr.value(char2) and: (char1.toUpper == char2.toUpper) | |
| }, | |
| // r4rs essential procedure: (char-ci<? char1 char2) | |
| 'char-ci<?': { |char1, char2| | |
| is_chr.value(char1) and: is_chr.value(char2) and: (char1.toUpper < char2.toUpper) | |
| }, | |
| // r4rs essential procedure: (char-ci>? char1 char2) | |
| 'char-ci>?': { |char1, char2| | |
| is_chr.value(char1) and: is_chr.value(char2) and: (char1.toUpper > char2.toUpper) | |
| }, | |
| // r4rs essential procedure: (char-ci<=? char1 char2) | |
| 'char-ci<=?': { |char1, char2| | |
| is_chr.value(char1) and: is_chr.value(char2) and: (char1.toUpper <= char2.toUpper) | |
| }, | |
| // r4rs essential procedure: (char-ci>=? char1 char2) | |
| 'char-ci>=?': { |char1, char2| | |
| is_chr.value(char1) and: is_chr.value(char2) and: (char1.toUpper >= char2.toUpper) | |
| }, | |
| // r4rs essential procedure: (char-alphabetic? char) | |
| 'char-alphabetic?': { |char| | |
| is_chr.value(char) and: char.isAlpha | |
| }, | |
| // r4rs essential procedure: (char-lower-case? letter) | |
| 'char-lower-case?': { |letter| | |
| is_chr.value(letter) and: letter.isLower | |
| }, | |
| // r4rs essential procedure: (char-numeric? char) | |
| 'char-numeric?': { |char| | |
| is_chr.value(char) and: char.isDecDigit | |
| }, | |
| // r4rs essential procedure: (char-upper-case? letter) | |
| 'char-upper-case?': { |letter| | |
| is_chr.value(letter) and: letter.isUpper | |
| }, | |
| // r4rs essential procedure: (char-whitespace? char) | |
| 'char-whitespace?': { |char| | |
| is_chr.value(char) and: char.isSpace | |
| }, | |
| // r4rs essential procedure: (char->integer char) | |
| 'char->integer': { |char| | |
| char.ascii | |
| }, | |
| // r4rs essential procedure: (char-upcase char) | |
| 'char-upcase': { |char| | |
| char.toUpper | |
| }, | |
| // r4rs essential procedure: (char-downcase char) | |
| 'char-downcase': { |char| | |
| char.toLower | |
| }, | |
| // r4rs essential procedure: (complex? obj) | |
| 'complex?': { |obj| | |
| false | |
| }, | |
| // r4rs essential procedure: (car pair) | |
| 'car': { |pair| | |
| pair[0]; | |
| }, | |
| // r4rs essential procedure: (cdr pair) | |
| 'cdr': { |pair| | |
| pair[1..] | |
| }, | |
| // r4rs essential procedure: (ceiling x) | |
| 'ceiling': { |x| | |
| x.ceil.asInteger | |
| }, | |
| // r4rs essential procedure: (cons obj1 obj2) | |
| 'cons': { |obj1, obj2| | |
| [obj1] ++ obj2 | |
| }, | |
| // r4rs essential procedure: (display obj) | |
| // r4rs essential procedure: (display obj port) TODO | |
| 'display': { |obj| | |
| if (is_str.value(obj)) { | |
| obj.post; | |
| } { | |
| scheme_str.value(obj).post; | |
| }; | |
| nil; | |
| }, | |
| 'do': { |init_exprs, test_exprs, commands| | |
| // r4rs syntax: | |
| // (do ((<variable1> <init1> <step1>) | |
| // ...) (<test> <expression> ...) <command> ...) | |
| Error("TODO: do").throw; | |
| }, | |
| // r4rs essential procedure: (eof-object? obj) | |
| 'eof-object?': { |obj| | |
| Error("TODO: eof-object?").throw; | |
| }, | |
| // r4rs essential procedure: (eq? obj1 obj2) | |
| 'eq?': { |obj1, obj2| | |
| obj1 === obj2 | |
| }, | |
| // r4rs essential procedure: (eqv? obj1 obj2) | |
| 'eqv?': { |obj1, obj2| | |
| // TODO: unreasonable performance | |
| // The eqv? procedure returns #t if: | |
| // obj1 and obj2 are both #t or both #f | |
| ((obj1 == true) and: (obj2 == true)) | |
| or: | |
| ((obj1 == false) and: (obj2 == false)) | |
| or: | |
| // obj1 and obj2 are both symbols and | |
| // (string=? (symbol->string obj1) (symbol->string obj2)) ==> #t | |
| (is_sym.value(obj1) and: is_sym.value(obj2) and: (obj1.asString == obj2.asString)) // TODO: DRY with string=? | |
| or: | |
| // obj1 and obj2 are both numbers, are numerically equal (see =, section see section 6.5 Numbers), and are either both exact or both inexact. | |
| (is_number.value(obj1) and: is_number.value(obj2) and: (obj1 == obj2)) // TODO: DRY with = | |
| or: | |
| // obj1 and obj2 are both characters and are the same character according to the char=? procedure | |
| (is_chr.value(obj1) and: is_chr.value(obj2) and: (obj1 == obj2)) // TODO: DRY with char=? | |
| or: | |
| // both obj1 and obj2 are the empty list | |
| (is_empty_list.value(obj1) and: is_empty_list.value(obj2)) | |
| or: | |
| // obj1 and obj2 are procedures whose location tags are equal | |
| (is_procedure.value(obj1) and: is_procedure.value(obj2) and: (obj1 === obj2)) | |
| or: | |
| // obj1 and obj2 are pairs, vectors, or strings that denote the same locations in the store | |
| (is_pair.value(obj1) and: is_pair.value(obj2) and: (obj1 === obj2)) | |
| or: | |
| (is_str.value(obj1) and: is_str.value(obj2) and: (obj1 === obj2)) | |
| or: | |
| (is_vector.value(obj1) and: is_vector.value(obj2) and: (obj1 === obj2)) | |
| }, | |
| // r4rs essential procedure: (equal? obj1 obj2) | |
| 'equal?': { |obj1, obj2| | |
| obj1 == obj2 | |
| }, | |
| 'expt': { |z1, z2| | |
| // r4rs procedure: expt z1 z2 | |
| z1.pow(z2); | |
| }, | |
| // r4rs essential procedure: (exact? z) | |
| 'exact?': { |z| | |
| z.isKindOf(Integer) | |
| }, | |
| // r4rs essential procedure: (even? z) | |
| 'even?': { |z| | |
| (z mod: 2) == 0 | |
| }, | |
| // r4rs essential procedure: (floor x) | |
| 'floor': { |x| | |
| x.floor.asInteger | |
| }, | |
| // r4rs essential procedure: (for-each proc list1 list2 ...) TODO: test | |
| 'for-each': { |proc ... lists| | |
| var result; | |
| lists.first.do { |element, i| | |
| var args = lists[1..].collect { |list| | |
| list[i] | |
| }; | |
| result = proc.valueArray(args); | |
| }; | |
| result; | |
| }, | |
| // r4rs essential procedure: (gcd n1 ...) | |
| 'gcd': { |... args| | |
| Error("TODO: gcd").throw; | |
| }, | |
| // r4rs essential procedure: (inexact? z) | |
| 'inexact?': { |z| | |
| z.isKindOf(Float) | |
| }, | |
| // r4rs essential procedure: (input-port? obj) | |
| 'input-port?': { |obj| | |
| Error("TODO: input-port?").throw; | |
| }, | |
| // r4rs essential procedure: (integer? obj) | |
| 'integer?': { |obj| | |
| obj.isKindOf(Integer) | |
| }, | |
| // r4rs essential procedure: (integer->char n) | |
| 'integer->char': { |n| | |
| n.asAscii | |
| }, | |
| // r4rs essential procedure: (lcm n1 ...) | |
| 'lcm': { |... args| | |
| Error("TODO: lcm").throw; | |
| }, | |
| // r4rs essential procedure: (length list) | |
| 'length': { |list| | |
| list.size; | |
| }, | |
| // r4rs essential procedure: (list obj ...) | |
| 'list': { |...objs| | |
| objs | |
| }, | |
| // r4rs essential procedure: (list? obj) | |
| 'list?': { |obj| | |
| is_list.value(obj) | |
| }, | |
| // r4rs essential procedure: (list-ref list k) | |
| 'list-ref': { |list, k| | |
| /* | |
| TODO | |
| This is the same as the car of (list-tail list k) | |
| */ | |
| list[k]; | |
| }, | |
| // r4rs essential procedure: (list->string chars) | |
| 'list->string': { |chars| | |
| chars.join | |
| }, | |
| // r4rs essential procedure: (list->vector list) | |
| 'list->vector': { |list| | |
| (__type__: 'vector', content: list.copy ); | |
| }, | |
| 'list-tail': { |list, k| | |
| // r4rs procedure: list-tail list k | |
| /* | |
| TODO: | |
| (define list-tail | |
| (lambda (x k) | |
| (if (zero? k) | |
| x | |
| (list-tail (cdr x) (- k 1))))) | |
| */ | |
| list.drop(k); | |
| }, | |
| // r4rs essential procedure: (load filename) | |
| 'load': { |filename| | |
| Error("TODO: load").throw; | |
| }, | |
| // r4rs essential procedure: (make-string k) | |
| // r4rs essential procedure: (make-string k char) | |
| 'make-string': { |k, char| | |
| ((char ? $ ) ! k).join | |
| }, | |
| // r4rs essential procedure: (make-vector k) | |
| 'make-vector': { |k, fill| | |
| // procedure: make-vector k fill | |
| (__type__: 'vector', content: Array.fill(k, fill) ); | |
| }, | |
| // r4rs essential procedure: (map proc list1 list2 ...) | |
| 'map': { |proc ... lists| | |
| lists.first.collect { |element, i| | |
| var args = lists.collect { |list| | |
| list[i] | |
| }; | |
| proc.valueArray(args); | |
| }; | |
| }, | |
| // r4rs essential procedure: (max x1 x2 ...) TODO varargs | |
| 'max': { |x1, x2| | |
| x1.max(x2) | |
| }, | |
| // r4rs essential procedure: (min x1 x2 ...) TODO varargs | |
| 'min': { |x1, x2| | |
| x1.min(x2) | |
| }, | |
| // r4rs essential procedure: (modulo n1 n2) TODO: "number theoretic" | |
| 'modulo': { |n1, n2| | |
| n1 % n2 | |
| }, | |
| // r4rs essential procedure: (negative? z) | |
| 'negative?': { |z| | |
| z < 0 | |
| }, | |
| // r4rs essential procedure: (newline) | |
| // r4rs essential procedure: (newline port) TODO | |
| 'newline': { | |
| "".postln; | |
| nil; | |
| }, | |
| // r4rs essential procedure: (not obj) | |
| 'not': { |obj| | |
| if (obj == false) { | |
| true | |
| } { | |
| false | |
| }; | |
| }, | |
| // r4rs essential procedure: (null? obj) | |
| 'null?': { |obj| | |
| obj == [] | |
| }, | |
| // r4rs essential procedure: (number? obj) | |
| 'number?': { |obj| | |
| is_number.value(obj); | |
| }, | |
| // r4rs essential procedure: (number->string number) | |
| // r4rs essential procedure: (number->string number radix) TODO | |
| 'number->string': { |number| | |
| // TODO: check type | |
| number.asString | |
| }, | |
| // r4rs essential procedure: (odd? z) | |
| 'odd?': { |z| | |
| ((z mod: 2) == 0).not | |
| }, | |
| // r4rs essential procedure: (open-input-file filename) | |
| 'open-input-file': { |filename| | |
| Error("TODO: open-input-file").throw; | |
| }, | |
| // r4rs essential procedure: (open-output-file filename) | |
| 'open-output-file': { |filename| | |
| Error("TODO: open-output-file").throw; | |
| }, | |
| // r4rs essential procedure: (output-port? obj) | |
| 'output-port?': { |obj| | |
| Error("TODO: output-port?").throw; | |
| }, | |
| // r4rs essential procedure: (pair? obj) | |
| 'pair?': { |obj| | |
| is_pair.value(obj); | |
| }, | |
| // r4rs essential procedure: (peek-char) TODO | |
| // r4rs essential procedure: (peek-char port) TODO | |
| 'peek-char': { |port| | |
| Error("TODO: peek-char").throw; | |
| }, | |
| 'pi': pi, // TODO not in r4rs? | |
| // r4rs essential procedure: (positive? z) | |
| 'positive?': { |z| | |
| z > 0 | |
| }, | |
| // r4rs essential procedure: (procedure? obj) | |
| 'procedure?': { |obj| | |
| is_procedure.value(obj) | |
| }, | |
| // r4rs essential procedure: (quotient n1 n2) TODO | |
| 'quotient': { |n1, n2| | |
| Error("TODO: quotient").throw; | |
| }, | |
| // r4rs essential procedure: (rational? obj) | |
| 'rational?': { |obj| | |
| false | |
| }, | |
| // r4rs essential procedure: (read) TODO | |
| // r4rs essential procedure: (read port) TODO | |
| 'read': { |port| | |
| Error("TODO: read").throw; | |
| }, | |
| // r4rs essential procedure: (read-char) TODO | |
| // r4rs essential procedure: (read-char port) TODO | |
| 'read-char': { |port| | |
| Error("TODO: read-char").throw; | |
| }, | |
| // r4rs essential procedure: (real? obj) | |
| 'real?': { |obj| | |
| obj.isKindOf(Float) | |
| }, | |
| // r4rs essential procedure: (remainder n1 n2) TODO | |
| 'remainder': { |n1, n2| | |
| Error("TODO: remainder").throw; | |
| }, | |
| // r4rs essential procedure: (reverse list) | |
| 'reverse': { |list| | |
| list.reverse | |
| }, | |
| // r4rs essential procedure: (round x) | |
| 'round': { |x| | |
| x.round.asInteger | |
| }, | |
| // r4rs essential procedure: (set-car! pair obj) | |
| 'set-car!': { |pair, obj| | |
| Error("TODO: set-car!").throw; | |
| }, | |
| // r4rs essential procedure: (set-cdr! pair obj) | |
| 'set-cdr!': { |pair, obj| | |
| Error("TODO: set-cdr!").throw; | |
| }, | |
| 'sqrt': { |z| | |
| // r4rs procedure: sqrt z | |
| z.sqrt | |
| }, | |
| // r4rs essential procedure: (string? obj) | |
| 'string?': { |obj| | |
| is_list.value(obj) | |
| }, | |
| // r4rs essential procedure: (string char ...) | |
| 'string': { |... char| | |
| // TODO: validate it's all chars | |
| char.join; | |
| }, | |
| // r4rs essential procedure: (string-length string) | |
| 'string-length': { |string| | |
| // TODO: validate it's String? | |
| string.size | |
| }, | |
| // r4rs essential procedure: (string-ref string k) | |
| 'string-ref': { |string, k| | |
| // TODO: validate it's String? | |
| string[k]; | |
| }, | |
| // r4rs essential procedure: (string-set! string k char) | |
| 'string-set!': { |string, k, char| | |
| // TODO: sclang strings are immutable | |
| Error("TODO: string-set!").throw; | |
| }, | |
| // r4rs essential procedure: (string=? string1 string2) | |
| 'string=?': { |string1, string2| | |
| is_str.value(string1) and: is_str.value(string2) and: (string1 == string2) | |
| }, | |
| // r4rs essential procedure: (string-append string ...) | |
| 'string-append': { |...strings| | |
| var value = ""; | |
| strings.do { |str| | |
| value = value ++ str; | |
| }; | |
| value; | |
| }, | |
| // r4rs essential procedure: (string->list string) | |
| 'string->list': { |string| | |
| var list = Array.new; | |
| string.size.do { |i| | |
| list = list.add(string[i]); | |
| }; | |
| list; | |
| }, | |
| // r4rs essential procedure: (string->number string) | |
| // r4rs essential procedure: (string->number string radix) TODO | |
| 'string->number': { |string| | |
| // TODO: check type | |
| string.asFloat | |
| }, | |
| // r4rs essential procedure: (string->symbol string) | |
| 'string->symbol': { |string| | |
| if (is_str.value(string)) { | |
| string.asSymbol; | |
| } { | |
| Error("TODO").throw; | |
| }; | |
| }, | |
| // r4rs essential procedure: (string-ci=? string1 string2) | |
| 'string-ci=?': { |string1, string2| | |
| is_list.value(string1) and: is_list.value(string2) and: (string1.toUpper == string2.toUpper) | |
| }, | |
| // r4rs essential procedure: (string<? string1 string2) | |
| 'string<?': { |string1, string2| | |
| is_list.value(string1) and: is_list.value(string2) and: (string1 < string2) | |
| }, | |
| // r4rs essential procedure: (string>? string1 string2) | |
| 'string>?': { |string1, string2| | |
| is_list.value(string1) and: is_list.value(string2) and: (string1 > string2) | |
| }, | |
| // r4rs essential procedure: (string<=? string1 string2) | |
| 'string<=?': { |string1, string2| | |
| is_list.value(string1) and: is_list.value(string2) and: (string1 <= string2) | |
| }, | |
| // r4rs essential procedure: (string>=? string1 string2) | |
| 'string>=?': { |string1, string2| | |
| is_list.value(string1) and: is_list.value(string2) and: (string1 >= string2) | |
| }, | |
| // r4rs essential procedure: (string-ci<? string1 string2) | |
| 'string-ci<?': { |string1, string2| | |
| is_list.value(string1) and: is_list.value(string2) and: (string1.toUpper < string2.toUpper) | |
| }, | |
| // r4rs essential procedure: (string-ci>? string1 string2) | |
| 'string-ci>?': { |string1, string2| | |
| is_list.value(string1) and: is_list.value(string2) and: (string1.toUpper > string2.toUpper) | |
| }, | |
| // r4rs essential procedure: (string-ci<=? string1 string2) | |
| 'string-ci<=?': { |string1, string2| | |
| is_list.value(string1) and: is_list.value(string2) and: (string1.toUpper <= string2.toUpper) | |
| }, | |
| // r4rs essential procedure: (string-ci>=? string1 string2) | |
| 'string-ci>=?': { |string1, string2| | |
| is_list.value(string1) and: is_list.value(string2) and: (string1.toUpper >= string2.toUpper) | |
| }, | |
| 'string->symbol': { |string| | |
| // r4rs essential procedure: string->symbol string | |
| if (is_list.value(string)) { | |
| string.asSymbol; | |
| } { | |
| Error("TODO").throw; | |
| }; | |
| }, | |
| // r4rs essential procedure: (substring string start end) | |
| 'substring': { |string, start, end| | |
| // TODO: String must be a string, and start and end must be exact integers satisfying 0 <= start <= end <= (string-length string). | |
| string[start, end-1] | |
| }, | |
| // r4rs essential procedure: (symbol? obj) | |
| 'symbol?': { |obj| | |
| is_sym.value(obj) | |
| }, | |
| // r4rs essential procedure: (symbol->string symbol) | |
| 'symbol->string': { |symbol| | |
| if (is_sym.value(symbol)) { | |
| symbol.asString; | |
| } { | |
| Error("TODO").throw; | |
| }; | |
| }, | |
| // r4rs essential procedure: (truncate x) | |
| 'truncate': { |x| | |
| x.trunc.asInteger | |
| }, | |
| // r4rs essential procedure: (write obj) | |
| // r4rs essential procedure: (write obj port) | |
| 'write': { |obj, port| | |
| Error("TODO: write").throw; | |
| }, | |
| // r4rs essential procedure: (write-char char) | |
| // r4rs essential procedure: (write-char char port) | |
| 'write-char': { |char, port| | |
| Error("TODO: write-char").throw; | |
| }, | |
| // r4rs essential procedure: (vector obj ...) | |
| 'vector': { |...args| | |
| (__type__: 'vector', content: args ) // TODO: or use proto or parent event? | |
| }, | |
| // r4rs essential procedure: (vector? obj) | |
| 'vector?': { |obj| | |
| is_vector.value(obj) | |
| }, | |
| 'vector-fill!': { |vector, fill| | |
| // r4rs procedure: vector-fill! vector fill | |
| vector.fill(fill); | |
| }, | |
| // r4rs essential procedure: (vector-length vector) | |
| 'vector-length': { |vector| | |
| vector['content'].size | |
| }, | |
| // r4rs essential procedure: (vector-ref vector k) | |
| 'vector-ref': { |vector, k| | |
| vector['content'][k] | |
| }, | |
| // r4rs essential procedure: (vector-set! vector k obj) | |
| 'vector-set!': { |vector, k, obj| | |
| vector['content'][k] = obj | |
| }, | |
| // r4rs essential procedure: (vector->list vector) | |
| 'vector->list': { |vector| | |
| Array.newFrom(vector['content']); | |
| }, | |
| // r4rs essential procedure: (zero? z) | |
| 'zero?': { |z| | |
| z == 0 | |
| } | |
| ); | |
| define_non_prim_standard_procedures_2.value(procedures); | |
| procedures; | |
| }; | |
| var | |
| define_non_prim_standard_procedures = | |
| { |env| | |
| // TODO: assq, assv, assoc possible to DRY | |
| // TODO: memq, memv, member possible to DRY | |
| var standard_procedure_defs = | |
| " | |
| ; r4rs essential procedure: (assq obj alist) | |
| ; | |
| (define assq | |
| (lambda (obj alist) | |
| (cond | |
| [(null? alist) #f] | |
| [(eq? obj (caar alist)) (car alist)] | |
| [else (assoc obj (cdr alist))]))) ; TODO: assoc here? not assq? | |
| ; r4rs essential procedure: (assv obj alist) | |
| ; | |
| (define assv | |
| (lambda (obj alist) | |
| (cond | |
| [(null? alist) #f] | |
| [(eqv? obj (caar alist)) (car alist)] | |
| [else (assoc obj (cdr alist))]))) ; TODO: assoc here? not assv? | |
| ; r4rs essential procedure: (assoc obj alist) | |
| ; | |
| (define assoc | |
| (lambda (obj alist) | |
| (cond | |
| [(null? alist) #f] | |
| [(equal? obj (caar alist)) (car alist)] | |
| [else (assoc obj (cdr alist))]))) | |
| ; r4rs essential procedure: (memq obj list) | |
| ; | |
| (define memq | |
| (lambda (obj list) | |
| (cond | |
| [(null? list) #f] | |
| [(eq? obj (car list)) list] | |
| [else (member obj (cdr list))]))) | |
| ; r4rs essential procedure: (memv obj list) | |
| ; | |
| (define memv | |
| (lambda (obj list) | |
| (cond | |
| [(null? list) #f] | |
| [(eqv? obj (car list)) list] | |
| [else (member obj (cdr list))]))) | |
| ; r4rs essential procedure: (member obj list) | |
| ; | |
| (define member | |
| (lambda (obj list) | |
| (cond | |
| [(null? list) #f] | |
| [(equal? obj (car list)) list] | |
| [else (member obj (cdr list))]))) | |
| ; r4rs essential procedures: caar ... cdddr | |
| ; | |
| (define caar | |
| (lambda (list) | |
| (car (car list)))) | |
| ; | |
| (define caar | |
| (lambda (list) | |
| (car (car list)))) | |
| ; | |
| (define cadr | |
| (lambda (list) | |
| (car (cdr list)))) | |
| ; | |
| (define cdar | |
| (lambda (list) | |
| (cdr (car list)))) | |
| ; | |
| (define cddr | |
| (lambda (list) | |
| (cdr (cdr list)))) | |
| ; | |
| (define caaar | |
| (lambda (list) | |
| (car (car (car list))))) | |
| ; | |
| (define caadr | |
| (lambda (list) | |
| (car (car (cdr list))))) | |
| ; | |
| (define cadar | |
| (lambda (list) | |
| (car (cdr (car list))))) | |
| ; | |
| (define caddr | |
| (lambda (list) | |
| (car (cdr (cdr list))))) | |
| ; | |
| (define cdaar | |
| (lambda (list) | |
| (cdr (car (car list))))) | |
| ; | |
| (define cdadr | |
| (lambda (list) | |
| (cdr (car (cdr list))))) | |
| ; | |
| (define cddar | |
| (lambda (list) | |
| (cdr (cdr (car list))))) | |
| ; | |
| (define cdddr | |
| (lambda (list) | |
| (cdr (cdr (cdr list))))) | |
| ; | |
| "; | |
| standard_procedure_defs.split($;).select { |str| | |
| str.contains("(define ") | |
| }.do { |standard_procedure_def| | |
| read.value(standard_procedure_def).postcs; | |
| eval.value(read.value(standard_procedure_def), env); | |
| }; | |
| }; | |
| var | |
| define_non_prim_standard_procedures_2 = | |
| { |env| | |
| // TODO: assq, assv, assoc possible to DRY | |
| /* | |
| [ 'define', 'assq', | |
| [ 'lambda', [ 'obj', 'alist' ], | |
| [ 'cond', | |
| [ [ 'null?', 'alist' ], false ], | |
| [ [ 'eq?', 'obj', [ 'caar', 'alist' ] ], [ 'car', 'alist' ] ], | |
| [ 'else', [ 'assoc', 'obj', [ 'cdr', 'alist' ] ] ] ] ] ] | |
| */ | |
| // TODO: memq, memv, member possible to DRY | |
| /* | |
| var standard_procedure_defs = | |
| [ | |
| // r4rs essential procedure: (assq obj alist) | |
| ['define', 'assq', | |
| ['lambda', ['obj', 'alist'], | |
| ['cond', | |
| [['null?', 'alist'], '#f'], | |
| [['eq?', 'obj', ['caar', 'alist']], ['car', 'alist']], | |
| ['else', ['assoc', 'obj', ['cdr', 'alist']]]]]], | |
| // r4rs essential procedure: (assv obj alist) | |
| ['define', 'assv', | |
| ['lambda', ['obj', 'alist'], | |
| ['cond', | |
| [['null?', 'alist'], '#f'], | |
| [['eqv?', 'obj', ['caar', 'alist']], ['car', 'alist']], | |
| ['else', ['assoc', 'obj', ['cdr', 'alist']]]]]], | |
| // r4rs essential procedure: (assoc obj alist) | |
| ['define', 'assoc', | |
| ['lambda', ['obj', 'alist'], | |
| ['cond', | |
| [['null?', 'alist'], '#f'], | |
| [['equal?', 'obj', ['caar', 'alist']], ['car', 'alist']], | |
| ['else', ['assoc', 'obj', ['cdr', 'alist']]]]]], | |
| ] | |
| ; | |
| */ | |
| var standard_procedure_defs = | |
| [ | |
| [ 'define', 'assq', [ 'lambda', [ 'obj', 'alist' ], [ 'cond', [ [ 'null?', 'alist' ], false ], [ [ 'eq?', 'obj', [ 'caar', 'alist' ] ], [ 'car', 'alist' ] ], [ 'else', [ 'assoc', 'obj', [ 'cdr', 'alist' ] ] ] ] ] ], | |
| [ 'define', 'assv', [ 'lambda', [ 'obj', 'alist' ], [ 'cond', [ [ 'null?', 'alist' ], false ], [ [ 'eqv?', 'obj', [ 'caar', 'alist' ] ], [ 'car', 'alist' ] ], [ 'else', [ 'assoc', 'obj', [ 'cdr', 'alist' ] ] ] ] ] ], | |
| [ 'define', 'assoc', [ 'lambda', [ 'obj', 'alist' ], [ 'cond', [ [ 'null?', 'alist' ], false ], [ [ 'equal?', 'obj', [ 'caar', 'alist' ] ], [ 'car', 'alist' ] ], [ 'else', [ 'assoc', 'obj', [ 'cdr', 'alist' ] ] ] ] ] ], | |
| [ 'define', 'memq', [ 'lambda', [ 'obj', 'list' ], [ 'cond', [ [ 'null?', 'list' ], false ], [ [ 'eq?', 'obj', [ 'car', 'list' ] ], 'list' ], [ 'else', [ 'member', 'obj', [ 'cdr', 'list' ] ] ] ] ] ], | |
| [ 'define', 'memv', [ 'lambda', [ 'obj', 'list' ], [ 'cond', [ [ 'null?', 'list' ], false ], [ [ 'eqv?', 'obj', [ 'car', 'list' ] ], 'list' ], [ 'else', [ 'member', 'obj', [ 'cdr', 'list' ] ] ] ] ] ], | |
| [ 'define', 'member', [ 'lambda', [ 'obj', 'list' ], [ 'cond', [ [ 'null?', 'list' ], false ], [ [ 'equal?', 'obj', [ 'car', 'list' ] ], 'list' ], [ 'else', [ 'member', 'obj', [ 'cdr', 'list' ] ] ] ] ] ], | |
| [ 'define', 'caar', [ 'lambda', [ 'list' ], [ 'car', [ 'car', 'list' ] ] ] ], | |
| [ 'define', 'caar', [ 'lambda', [ 'list' ], [ 'car', [ 'car', 'list' ] ] ] ], | |
| [ 'define', 'cadr', [ 'lambda', [ 'list' ], [ 'car', [ 'cdr', 'list' ] ] ] ], | |
| [ 'define', 'cdar', [ 'lambda', [ 'list' ], [ 'cdr', [ 'car', 'list' ] ] ] ], | |
| [ 'define', 'cddr', [ 'lambda', [ 'list' ], [ 'cdr', [ 'cdr', 'list' ] ] ] ], | |
| [ 'define', 'caaar', [ 'lambda', [ 'list' ], [ 'car', [ 'car', [ 'car', 'list' ] ] ] ] ], | |
| [ 'define', 'caadr', [ 'lambda', [ 'list' ], [ 'car', [ 'car', [ 'cdr', 'list' ] ] ] ] ], | |
| [ 'define', 'cadar', [ 'lambda', [ 'list' ], [ 'car', [ 'cdr', [ 'car', 'list' ] ] ] ] ], | |
| [ 'define', 'caddr', [ 'lambda', [ 'list' ], [ 'car', [ 'cdr', [ 'cdr', 'list' ] ] ] ] ], | |
| [ 'define', 'cdaar', [ 'lambda', [ 'list' ], [ 'cdr', [ 'car', [ 'car', 'list' ] ] ] ] ], | |
| [ 'define', 'cdadr', [ 'lambda', [ 'list' ], [ 'cdr', [ 'car', [ 'cdr', 'list' ] ] ] ] ], | |
| [ 'define', 'cddar', [ 'lambda', [ 'list' ], [ 'cdr', [ 'cdr', [ 'car', 'list' ] ] ] ] ], | |
| [ 'define', 'cdddr', [ 'lambda', [ 'list' ], [ 'cdr', [ 'cdr', [ 'cdr', 'list' ] ] ] ] ], | |
| [ 'define', 'assq', [ 'lambda', [ 'obj', 'alist' ], [ 'cond', [ [ 'null?', 'alist' ], false ], [ [ 'eq?', 'obj', [ 'caar', 'alist' ] ], [ 'car', 'alist' ] ], [ 'else', [ 'assoc', 'obj', [ 'cdr', 'alist' ] ] ] ] ] ], | |
| [ 'define', 'assv', [ 'lambda', [ 'obj', 'alist' ], [ 'cond', [ [ 'null?', 'alist' ], false ], [ [ 'eqv?', 'obj', [ 'caar', 'alist' ] ], [ 'car', 'alist' ] ], [ 'else', [ 'assoc', 'obj', [ 'cdr', 'alist' ] ] ] ] ] ], | |
| [ 'define', 'assoc', [ 'lambda', [ 'obj', 'alist' ], [ 'cond', [ [ 'null?', 'alist' ], false ], [ [ 'equal?', 'obj', [ 'caar', 'alist' ] ], [ 'car', 'alist' ] ], [ 'else', [ 'assoc', 'obj', [ 'cdr', 'alist' ] ] ] ] ] ], | |
| [ 'define', 'memq', [ 'lambda', [ 'obj', 'list' ], [ 'cond', [ [ 'null?', 'list' ], false ], [ [ 'eq?', 'obj', [ 'car', 'list' ] ], 'list' ], [ 'else', [ 'member', 'obj', [ 'cdr', 'list' ] ] ] ] ] ], | |
| [ 'define', 'memv', [ 'lambda', [ 'obj', 'list' ], [ 'cond', [ [ 'null?', 'list' ], false ], [ [ 'eqv?', 'obj', [ 'car', 'list' ] ], 'list' ], [ 'else', [ 'member', 'obj', [ 'cdr', 'list' ] ] ] ] ] ], | |
| [ 'define', 'member', [ 'lambda', [ 'obj', 'list' ], [ 'cond', [ [ 'null?', 'list' ], false ], [ [ 'equal?', 'obj', [ 'car', 'list' ] ], 'list' ], [ 'else', [ 'member', 'obj', [ 'cdr', 'list' ] ] ] ] ] ], | |
| [ 'define', 'caar', [ 'lambda', [ 'list' ], [ 'car', [ 'car', 'list' ] ] ] ], | |
| [ 'define', 'caar', [ 'lambda', [ 'list' ], [ 'car', [ 'car', 'list' ] ] ] ], | |
| [ 'define', 'cadr', [ 'lambda', [ 'list' ], [ 'car', [ 'cdr', 'list' ] ] ] ], | |
| [ 'define', 'cdar', [ 'lambda', [ 'list' ], [ 'cdr', [ 'car', 'list' ] ] ] ], | |
| [ 'define', 'cddr', [ 'lambda', [ 'list' ], [ 'cdr', [ 'cdr', 'list' ] ] ] ], | |
| [ 'define', 'caaar', [ 'lambda', [ 'list' ], [ 'car', [ 'car', [ 'car', 'list' ] ] ] ] ], | |
| [ 'define', 'caadr', [ 'lambda', [ 'list' ], [ 'car', [ 'car', [ 'cdr', 'list' ] ] ] ] ], | |
| [ 'define', 'cadar', [ 'lambda', [ 'list' ], [ 'car', [ 'cdr', [ 'car', 'list' ] ] ] ] ], | |
| [ 'define', 'caddr', [ 'lambda', [ 'list' ], [ 'car', [ 'cdr', [ 'cdr', 'list' ] ] ] ] ], | |
| [ 'define', 'cdaar', [ 'lambda', [ 'list' ], [ 'cdr', [ 'car', [ 'car', 'list' ] ] ] ] ], | |
| [ 'define', 'cdadr', [ 'lambda', [ 'list' ], [ 'cdr', [ 'car', [ 'cdr', 'list' ] ] ] ] ], | |
| [ 'define', 'cddar', [ 'lambda', [ 'list' ], [ 'cdr', [ 'cdr', [ 'car', 'list' ] ] ] ] ], | |
| [ 'define', 'cdddr', [ 'lambda', [ 'list' ], [ 'cdr', [ 'cdr', [ 'cdr', 'list' ] ] ] ] ] | |
| ] | |
| ; | |
| standard_procedure_defs.do { |standard_procedure_def| | |
| eval.value(standard_procedure_def, env); | |
| }; | |
| }; | |
| var | |
| additional_procedures = | |
| { | |
| // TODO var funcName = 'additional_procedures'; | |
| ( | |
| 'hash': { |...args| // TODO: immutable hash table | |
| // racket (hash key val ... ...) | |
| var content = IdentityDictionary.new; | |
| args.pairsDo { |a, b| content[a] = eval.value(b) }; | |
| (__type__: 'hash', content: content) // TODO: __immutable_hash__ ?? | |
| }, | |
| 'make-hash': { |assocs| // TODO: mutable hash table | |
| // racket (make-hash [assocs]) | |
| var content = IdentityDictionary.new; | |
| assocs.do { |assoc| | |
| var key, value; | |
| # key ... value = assoc; | |
| content[key] = value // TODO: eval values(?) eval key? | |
| }; | |
| (__type__: 'hash', content: content) // TODO: __mutable_hash__ ?? | |
| }, | |
| 'hash-ref': { |hash, key| | |
| // racket (hash-ref hash key [failure-result]) TODO: failure-result | |
| hash['content'][key]; | |
| }, | |
| 'hash-set!': { |hash, key, v| | |
| // racket (hash-set! hash key v) | |
| hash['content'][key] = v; | |
| }, | |
| 'hash-count': { |hash| | |
| // racket (hash-count hash) | |
| hash['content'].size | |
| }, | |
| 'hash?': { |obj| | |
| // racket (hash? v) | |
| is_hash.value(obj) | |
| }, | |
| 'vector-filter': { |proc, vec| | |
| // racket (vector-filter pred vec) | |
| (__type__: 'vector', content: vec['content'].select(proc) ); | |
| }, | |
| 'vector-filter-not': { |proc, vec| | |
| // racket (vector-filter-not pred vec) | |
| (__type__: 'vector', content: vec['content'].reject(proc) ); | |
| }, | |
| 'vector-map': { |proc, vec| | |
| // racket (vector-map proc vec ...+) TODO: ...+ | |
| (__type__: 'vector', content: vec['content'].collect(proc) ); | |
| }, | |
| ); | |
| }; | |
| var | |
| read = | |
| { |str| | |
| var ss = ss_new.(str); | |
| var result = parse.(ss); | |
| result | |
| }; | |
| var | |
| parse = | |
| { |ss| | |
| var rg_ignore = "^\\s+"; | |
| var value; | |
| var result; | |
| var open_paren; | |
| ss_skip.(ss, rg_ignore); | |
| open_paren = ss_scan.(ss, "\\(") ? ss_scan.(ss, "\\["); | |
| case | |
| { open_paren.notNil } { | |
| var close_paren; | |
| var list; | |
| if (open_paren == "(") { | |
| close_paren = "^\\)"; | |
| } { | |
| close_paren = "^\\]"; | |
| }; | |
| ss_skip.(ss, rg_ignore); | |
| list = Array.new; | |
| while { ss_matches.(ss, close_paren).isNil } { | |
| list = list.add(parse.(ss)); | |
| ss_skip.(ss, rg_ignore); | |
| }; | |
| ss_skip.(ss, close_paren); | |
| result = list; | |
| } | |
| /* | |
| TODO: # only external representation? | |
| { is_vector_char.value(token) } { | |
| // TODO: validate a list follows | |
| var list = Array.new; | |
| list = ['vector'] ++ read_from_tokens.value(tokens); | |
| list; | |
| } | |
| */ | |
| { ss_scan.(ss, "^'").notNil } { | |
| // r4rs essential syntax: '<datum> | |
| var list = Array.new; | |
| list = list.add('quote'); | |
| list = list.add(parse.value(ss)); | |
| result = list | |
| } | |
| { ss_scan.(ss, "^`").notNil } { | |
| // r4rs essential syntax: `<template> | |
| var list = Array.new; | |
| list = list.add('quasiquote'); | |
| list = list.add(parse.value(ss)); | |
| result = list | |
| } | |
| { ss_scan.(ss, "^,@").notNil } { | |
| var list = Array.new; | |
| list = list.add('unquote-splicing'); | |
| list = list.add(parse.value(ss)); | |
| result = list | |
| } | |
| { ss_scan.(ss, "^,").notNil } { | |
| var list = Array.new; | |
| list = list.add('unquote'); | |
| list = list.add(parse.value(ss)); | |
| result = list | |
| } | |
| { true } { | |
| result = atom.(ss); | |
| } | |
| ; | |
| if (result.isNil) { | |
| if (ss_eos.(ss)) { | |
| Error("parse error: unexpected EOF").throw; | |
| } { | |
| // Error("parse error: unexpected token at %".format(ss_peek.(ss).quote)).throw; | |
| Error("parse error: unexpected token at %".format(ss_as_string.(ss).quote)).throw; | |
| }; | |
| }; | |
| expand.(result); | |
| }; | |
| var | |
| expand = | |
| { |x| | |
| // TODO var funcName = 'expand'; | |
| if (x.class != Array) { | |
| x | |
| } { | |
| var head, tail; | |
| # head ... tail = x; | |
| case | |
| { head == 'quote' } { | |
| if (tail.size != 1) { | |
| Error("in %: quote syntax error: 1 expression expected, got %".format(scheme_str.value(x), tail.size)).throw; | |
| } { | |
| x | |
| }; | |
| } | |
| { head == 'begin' } { | |
| // TODO: (begin) => None | |
| x | |
| } | |
| { head == 'define' } { | |
| if (x.size != 3) { | |
| Error("in %: expected == 3 expressions in define: got %".format(scheme_str.value(x), x.size)).throw; | |
| } { | |
| // (define (f args) body) => (define f (lambda (args) body)) | |
| var variable_part, body; | |
| # variable_part ... body = tail; | |
| if (is_list.value(variable_part)) { | |
| var variables, formals; | |
| # variables ... formals = variable_part; | |
| [ | |
| 'define', | |
| variables, | |
| // (lambda (x) e1 e2) => (lambda (x) (begin e1 e2)) | |
| expand_lambda.value([formals] ++ body) | |
| ] | |
| } { | |
| x | |
| } | |
| } | |
| } | |
| { head == 'lambda' } { | |
| if (x.size < 3) { | |
| Error("in %: expected >= 3 expressions in lambda: got %".format(scheme_str.value(x), x.size)).throw; | |
| } { | |
| // (lambda (x) e1 e2) => (lambda (x) (begin e1 e2)) | |
| expand_lambda.value(tail); | |
| }; | |
| } | |
| { head == 'quasiquote' } { | |
| // r4rs essential syntax: (quasiquote <template>) | |
| if (tail.size != 1) { | |
| Error("in %: quasiquote syntax error: 1 expression expected, got %".format(scheme_str.value(x), tail.size)).throw; | |
| } { | |
| expand_quasiquote.value(tail.first); | |
| }; | |
| } | |
| { true } { | |
| x.collect { |part| expand.value(part) }; | |
| }; | |
| }; | |
| }; | |
| // (lambda (x) e1 e2) => (lambda (x) (begin e1 e2)) | |
| var | |
| expand_lambda = | |
| { |tail| | |
| var formals, body, exp; | |
| # formals ... body = tail; | |
| /* | |
| TODO where vars == formals | |
| require(x, (isa(vars, list) and all(isa(v, Symbol) for v in vars)) | |
| or isa(vars, Symbol), "illegal lambda argument list") | |
| */ | |
| if (body.size == 1) { | |
| exp = body[0]; | |
| } { | |
| exp = [ 'begin' ] ++ body; | |
| }; | |
| [ | |
| 'lambda', | |
| formals, | |
| expand.value(exp) | |
| ]; | |
| }; | |
| /* | |
| Expand `x => 'x; `,x => x; `(,@x y) => (append x y) | |
| */ | |
| var | |
| expand_quasiquote = { |x| | |
| // TODO var funcName = 'expand_quasiquote'; | |
| if (is_pair.value(x).not) { | |
| ['quote', x] | |
| } { | |
| var head, tail; | |
| var continueFunc = { | |
| ['cons', expand_quasiquote.value(head), expand_quasiquote.value(tail)] | |
| }; | |
| # head ... tail = x; | |
| case | |
| { head == 'unquote' } { | |
| if (tail.size != 1) { | |
| Error("in %: quasiquote syntax error: 1 expression expected, got %".format(scheme_str.value(x), tail.size)).throw; | |
| } { | |
| tail.first; | |
| }; | |
| } | |
| { is_pair.value(head) } { | |
| if (head[0] == 'unquote-splicing') { // TODO: awkward due to non-shortcircuiting and in sclang | |
| [ 'append', head[1], expand_quasiquote.value(tail) ] | |
| } { | |
| continueFunc.value; | |
| } | |
| } | |
| { true } { | |
| continueFunc.value; | |
| }; | |
| }; | |
| }; | |
| var | |
| atom = | |
| { |ss| | |
| // TODO var funcName = 'atom'; | |
| var value; | |
| var rg_float = "(-?(?:0|[1-9]\\d*)(?:\\.\\d+(?i:e[+-]?\\d+)|\\.\\d+|(?i:e[+-]?\\d+)))"; | |
| var rg_integer = "-?0|-?[1-9]\\d*"; | |
| // var rg_symbol = "[0-9a-zA-Z_!|@=*/+-<>:;,.?&\\\\'']+"; | |
| var rg_symbol = "[a-zA-Z+-.*/<=>!?:\$%_&~\^][0-9a-zA-Z+-.*/<=>!?:\$%_&~\^]*"; | |
| var rg_char = "#\\\\[0-9a-zA-Z]"; | |
| var rg_char_space = "#\\\\space"; | |
| var rg_char_newline = "#\\\\newline"; | |
| var rg_boolean = "#[ft]"; | |
| var rg_string = "\"[0-9a-zA-Z_!|@=*/+-<>:;,.()?&#\\\\'']*\""; | |
| case | |
| { (value = ss_scan.(ss, rg_float)).notNil } { | |
| value.asFloat | |
| } | |
| { (value = ss_scan.(ss, rg_integer)).notNil } { | |
| value.asInteger | |
| } | |
| { (value = ss_scan.(ss, rg_symbol)).notNil } { | |
| value.asSymbol | |
| } | |
| { (value = ss_scan.(ss, rg_char_newline)).notNil } { | |
| Char.nl | |
| } | |
| { (value = ss_scan.(ss, rg_char_space)).notNil } { | |
| Char.space | |
| } | |
| { (value = ss_scan.(ss, rg_char)).notNil } { | |
| value[2] | |
| } | |
| { (value = ss_scan.(ss, rg_boolean)).notNil } { | |
| value == "#t" | |
| } | |
| { (value = ss_scan.(ss, rg_string)).notNil } { | |
| value[1..value.size-2].asString.replace("\\n", "\n") | |
| } | |
| /* | |
| TODO: ? | |
| { true } { | |
| Error("parse error, token: %".format(token)).throw; | |
| } | |
| */ | |
| }; | |
| var | |
| eval = | |
| { |x, env| | |
| // TODO var funcName = 'eval'; | |
| case | |
| { is_sym.value(x) } { | |
| // r4rs essential syntax: <variable> | |
| var found_env = find_env.value(env, x); | |
| if (found_env.notNil) { | |
| found_env[x]; | |
| } { | |
| // "%: undefined".format(x).error; | |
| Error("%: undefined".format(x)).throw; | |
| }; | |
| } | |
| { is_list.value(x) } { | |
| var op, args; | |
| # op ... args = x; | |
| case | |
| { op == 'and' } { | |
| // r4rs essential syntax: (and <test1> ...) | |
| var value = true; | |
| var index = 0; | |
| while { (value != false) and: (index < args.size) } { | |
| value = eval.value(args[index], env); | |
| index = index + 1; | |
| }; | |
| value; | |
| } | |
| { op == 'begin' } { | |
| // r4rs essential syntax: (begin <expression1> <expression2> ...) | |
| args.inject([nil, env]) { |val_env, exp| | |
| [eval.value(exp, val_env[1]), val_env[1]] | |
| }[0]; | |
| } | |
| { op == 'case' } { | |
| // r4rs essential syntax: (case <key> <clause1> <clause2> ...) | |
| var num_clauses = args.size-1; | |
| var key = eval.value(args[0], env); | |
| var i = 0; | |
| var result; | |
| while { result.isNil and: (i < num_clauses)} { | |
| var clause = args[1+i]; | |
| var object_expr = clause[0]; | |
| var then_body = clause[1]; | |
| result = case | |
| { object_expr == 'else' } { | |
| eval.value(then_body, env); // TODO can be made more DRY | |
| } | |
| { object_expr.includes(key) } { | |
| eval.value(then_body, env); | |
| }; | |
| i = i + 1; | |
| }; | |
| result; | |
| } | |
| { op == 'cond' } { | |
| // r4rs essential syntax: (cond <clause1> <clause2> ...) | |
| var num_clauses = args.size; | |
| var i = 0; | |
| var result; | |
| while { result.isNil and: (i < num_clauses)} { | |
| var clause = args[i]; | |
| var test_expr = clause[0]; | |
| var then_body = clause[1]; | |
| result = case | |
| { test_expr == 'else' } { | |
| eval.value(then_body, env); // TODO can be made more DRY | |
| } | |
| { eval.value(test_expr, env) } { | |
| eval.value(then_body, env); | |
| }; | |
| i = i + 1; | |
| }; | |
| result; | |
| } | |
| { op == 'define' } { | |
| var symbol, exp; | |
| # symbol, exp = args; | |
| env[symbol] = eval.value(exp, env); | |
| nil; | |
| } | |
| { op == 'if' } { | |
| // r4rs essential syntax: (if <test> <consequent> <alternate>) | |
| // r4rs syntax: (if <test> <consequent>) | |
| var test, conseq, alt; | |
| var expr; | |
| # test, conseq, alt = args; | |
| expr = if (eval.value(test, env), conseq, alt); // TODO: #t and #f only works?? | |
| if (expr.notNil) { | |
| eval.value(expr, env); | |
| }; | |
| } | |
| { op == 'lambda' } { | |
| // r4rs essential syntax: (lambda <formals> <body>) | |
| var formals, body; | |
| # formals, body = args; | |
| // TODO: might be optimized by not using a separate make_lambda function? | |
| make_lambda.value(formals, body, env); | |
| } | |
| { op == 'let' } { | |
| // r4rs essential syntax: (let <bindings> <body>) | |
| // Syntax: <bindings> should have the form ((<variable1> <init1>) ...), where each <init> is an expression, and <body> should be a sequence of one or more expressions | |
| var bindings, exprs, body; | |
| # bindings ... exprs = args; | |
| if (exprs.size == 1) { | |
| body = exprs[0]; | |
| } { | |
| body = ['begin'] ++ exprs; | |
| }; | |
| // TODO: might be optimized by not using a separate make_let/make_lambda functions? | |
| make_let.value(bindings, body, env); | |
| } | |
| { op == 'let*' } { | |
| // r4rs syntax: let* <bindings> <body> | |
| // Syntax: <bindings> should have the form ((<variable1> <init1>) ...), and <body> should be a sequence of one or more expressions. | |
| var bindings, exprs, body; | |
| # bindings ... exprs = args; | |
| if (exprs.size == 1) { | |
| body = exprs[0]; | |
| } { | |
| Error( | |
| "in %: let* body error: 1 expression expected, % found".format( | |
| scheme_str.value([op]++args), | |
| exprs.size | |
| ) | |
| ).throw; | |
| }; | |
| if (bindings.size == 0) { | |
| make_lambda.value([], body, env).value; | |
| } { | |
| var binding, rest; | |
| # binding ... rest = bindings; | |
| make_let.value( | |
| [binding], | |
| ['let*', rest, body], | |
| env | |
| ).value; | |
| }; | |
| } | |
| { op == 'letrec' } { | |
| // r4rs essential syntax: (letrec <bindings> <body>) | |
| // Syntax: <Bindings> should have the form ((<variable1> <init1>) ...), and <body> should be a sequence of one or more expressions | |
| Error("TODO: letrec").throw; | |
| } | |
| { op == 'or' } { | |
| // r4rs essential syntax: (or <test1> ...) | |
| var value = false; | |
| var index = 0; | |
| while { (value == false) and: (index < args.size) } { | |
| value = eval.value(args[index], env); | |
| index = index + 1; | |
| }; | |
| value; | |
| } | |
| { op == 'quote' } { | |
| // r4rs essential syntax: (quote <datum>) | |
| args.first; | |
| } | |
| { op == 'set!' } { | |
| // r4rs essential syntax: (set! <variable> <expression>) | |
| var variable, exprs, expression; | |
| # variable ... exprs = args; | |
| if (exprs.size != 1) { | |
| Error( | |
| "in %: set! expr error: 1 expression expected, not %".format( | |
| scheme_str.value([op]++exprs), exprs.size | |
| ) | |
| ).throw; | |
| }; | |
| expression = exprs[0]; | |
| find_env.value(env, variable)[variable] = eval.value(expression, env); | |
| nil; | |
| } | |
| { true } { | |
| // r4rs essential syntax: (<operator> <operand1> ...) | |
| var operator = op; | |
| var operands = args; | |
| var func = eval.value(operator, env); | |
| var vals; | |
| if (func.isNil) { | |
| Error("%: undefined".format(x)).throw; | |
| }; | |
| if (is_procedure.value(func).not) { | |
| Error("not a procedure: %".format(scheme_str.value(operator))).throw; | |
| }; | |
| vals = operands.collect { |a| eval.value(a, env) }; | |
| func.value(*vals); | |
| }; | |
| } | |
| { true } { | |
| // r4rs essential syntax: <constant> | |
| // TODO: this lets everything through, narrow scope? | |
| x; | |
| } | |
| }; | |
| var | |
| make_let = | |
| { |bindings, body, env| | |
| // derived expression type: | |
| // (let ((<variable1> <init1>) ...) | |
| // <body>) | |
| // == ((lambda (<variable1> ...) <body>) <init1> ...) | |
| // TODO var funcName = 'make_let'; | |
| var parse_letbinding = { |binding, env| | |
| // TODO var funcName = 'parse_letbinding'; | |
| [ binding[0], eval.value(binding[1], env) ] | |
| }; | |
| var vars, inits; | |
| // (bindings: bindings, body: body, env: env.keys).debug(funcName); | |
| vars = []; | |
| inits = []; | |
| bindings.do { |binding| | |
| var varr, init; | |
| # varr, init = parse_letbinding.value(binding, env); | |
| vars = vars.add(varr); | |
| inits = inits.add(init); | |
| }; | |
| make_lambda.value(vars, body, env).valueArray(inits); | |
| }; | |
| var | |
| make_lambda = | |
| { |formals, body, env| | |
| // TODO var funcName = 'make_lambda'; | |
| // (body: body, formals: formals, env: env.keys).debug(funcName); | |
| { |...args| eval.value(body, make_env.value(formals, args, env)) } | |
| }; | |
| var | |
| make_env = | |
| { |params([]), args([]), outer| | |
| // TODO var funcName = 'make_env'; | |
| var env = (); | |
| params.do { |param, i| | |
| env[param] = args[i]; | |
| }; | |
| env['__outer__'] = outer; // TODO: __outer__ is magic key. it should not be possible to define | |
| env; | |
| }; | |
| var | |
| find_env = | |
| { |env, symbol| | |
| // TODO var funcName = 'find_env'; | |
| if (env[symbol].notNil) { env } { | |
| var outer = env['__outer__']; | |
| if (outer.notNil) { | |
| find_env.value(outer, symbol); | |
| } | |
| }; | |
| }; | |
| var | |
| scheme_str = | |
| { |obj| | |
| // TODO var funcName = 'scheme_str'; | |
| case | |
| { is_boolean.value(obj) } { | |
| if (obj) { | |
| "#t"; | |
| } { | |
| "#f"; | |
| } | |
| } | |
| { is_number.value(obj) } { | |
| obj | |
| } | |
| { is_sym.value(obj) } { | |
| obj.asString | |
| } | |
| { is_chr.value(obj) } { | |
| case | |
| { obj == Char.nl } { | |
| "#\\newline"; | |
| } | |
| { obj == Char.space } { | |
| "#\\space"; | |
| } | |
| { true } { | |
| "#\\"++obj; | |
| } | |
| } | |
| { is_str.value(obj) } { | |
| obj.quote | |
| } | |
| { is_procedure.value(obj) } { | |
| "a procedure" | |
| } | |
| { is_list.value(obj) } { // TODO is_list | |
| "(" ++ obj.collect { |element| scheme_str.value(element) }.join($ ) ++ ")"; | |
| } | |
| { is_vector.value(obj) } { | |
| "#(" ++ obj['content'].collect { |element| scheme_str.value(element) }.join($ ) ++ ")"; | |
| } | |
| { is_hash.value(obj) } { | |
| var content = obj['content']; | |
| "#hash(" ++ content.keys.collect { |key| "(" ++ scheme_str.value(key) ++ " . " ++ scheme_str.value(content[key]) ++ ")" }.asArray.join($ ) ++ ")"; | |
| } | |
| ?? { | |
| Error("invalid obj: " ++ obj).throw; | |
| }; | |
| }; | |
| /* | |
| utility functions | |
| */ | |
| var | |
| is_boolean = | |
| { |obj| | |
| obj.isKindOf(Boolean) | |
| }; | |
| var | |
| is_number = | |
| { |obj| | |
| obj.isKindOf(Number) | |
| }; | |
| var | |
| is_sym = | |
| { |obj| | |
| obj.class == Symbol | |
| }; | |
| var | |
| is_chr = | |
| { |obj| | |
| obj.class == Char | |
| }; | |
| var | |
| is_str = | |
| { |obj| | |
| obj.class == String | |
| }; | |
| var | |
| is_procedure = | |
| { |obj| | |
| obj.class == Function; | |
| }; | |
| var | |
| is_list = | |
| { |obj| | |
| obj.class == Array | |
| }; | |
| var | |
| is_vector = | |
| { |obj| | |
| if (obj.class == Event) { | |
| obj['__type__'] == 'vector' // TODO: use parent or proto-table? | |
| } { | |
| false | |
| }; | |
| }; | |
| var | |
| is_hash = | |
| { |obj| | |
| if (obj.class == Event) { | |
| obj['__type__'] == 'hash' // TODO: use parent or proto-table? | |
| } { | |
| false | |
| }; | |
| }; | |
| var | |
| is_pair = | |
| { |obj| | |
| (obj.class == Array) and: (obj.size > 0) // TODO: not accurate | |
| }; | |
| var | |
| is_empty_list = | |
| { |obj| | |
| if (is_list.value(obj)) { | |
| obj.size == 0 // TODO: was set to 1, uhm? | |
| } { | |
| false | |
| }; | |
| }; | |
| /* | |
| string scanner | |
| ...code is based upon StringScanner in the ruby standard library | |
| */ | |
| var | |
| ss_new = | |
| { |str| | |
| IdentityDictionary[ | |
| 'pos' -> 0, | |
| 'peekLength' -> 100, | |
| 'str' -> str, | |
| 'debug' -> false | |
| ]; | |
| }; | |
| var | |
| ss_matches = | |
| { |ss, regexp| | |
| // TODO var funcName = 'ss_matches'; | |
| var match; | |
| match = ss_pr_find_regexp_directly_after_pos.(ss, regexp); | |
| match.notNil.if { | |
| if (ss['debug']) { "matched: '%'".format(match).debug }; | |
| match.size | |
| } { nil } | |
| }; | |
| var | |
| ss_scan = | |
| { |ss, regexp| | |
| // TODO var funcName = 'ss_scan'; | |
| var match; | |
| match = ss_pr_find_regexp_directly_after_pos.(ss, regexp); | |
| match.notNil.if { | |
| if (ss['debug']) { "scanned: '%'".format(match).debug }; | |
| ss['pos'] = ss['pos'] + match.size; | |
| match | |
| } { nil } | |
| }; | |
| var | |
| ss_scan_until = | |
| { |ss, regexp| | |
| // TODO var funcName = 'ss_scan_until'; | |
| var match_data; | |
| match_data = ss_pr_find_first_regexp_after_pos.(ss, regexp); | |
| match_data.notNil.if { | |
| ss['pos'] = ss['pos'] + match_data[0] + match_data[1].size; | |
| match_data[1] | |
| } { nil } | |
| }; | |
| var | |
| ss_skip = | |
| { |ss, regexp| | |
| // TODO var funcName = 'ss_skip'; | |
| var match; | |
| match = ss_pr_find_regexp_directly_after_pos.(ss, regexp); | |
| match.notNil.if { | |
| if (ss['debug']) { "skipped: '%'".format(match).debug }; | |
| ss['pos'] = ss['pos'] + match.size; | |
| match.size | |
| } { nil } | |
| }; | |
| var | |
| ss_skip_until = | |
| { |ss, regexp| | |
| // TODO var funcName = 'ss_skip_until'; | |
| var match_data; | |
| match_data = ss_pr_find_first_regexp_after_pos(ss, regexp); | |
| match_data.notNil.if { | |
| ss['pos'] = ss['pos'] + match_data[0] + match_data[1].size; | |
| match_data[1].size | |
| } { nil } | |
| }; | |
| var | |
| ss_get_char = | |
| { |ss| | |
| // TODO var funcName = 'ss_get_char'; | |
| var char; | |
| char = ss['str'][ss['pos']]; | |
| ss['pos'] = ss['pos'] + 1; | |
| char | |
| }; | |
| var | |
| ss_reset = | |
| { |ss| | |
| // TODO var funcName = 'ss_reset'; | |
| ss['pos'] = 0; | |
| }; | |
| var | |
| ss_eos = | |
| { |ss| | |
| // TODO var funcName = 'ss_eos'; | |
| ss_at_end_of_string.(ss); | |
| }; | |
| var | |
| ss_bos = | |
| { |ss| | |
| // TODO var funcName = 'ss_bos'; | |
| ss_at_beginning_of_string.(ss); | |
| }; | |
| var | |
| ss_at_end_of_string = | |
| { |ss| | |
| // TODO var funcName = 'ss_at_end_of_string'; | |
| ss['pos'] == ss_pr_eos_pos.(ss); | |
| }; | |
| var | |
| ss_at_beginning_of_string = | |
| { |ss| | |
| // TODO var funcName = 'ss_at_beginning_of_string'; | |
| ss['pos'] == 0; | |
| }; | |
| var | |
| ss_peek = | |
| { |ss| | |
| // TODO var funcName = 'ss_peek'; | |
| ss['str'][ss['pos']..(ss['pos']+ss['peekLength']-1)] | |
| }; | |
| var | |
| ss_as_string = | |
| { |ss| | |
| // TODO var funcName = 'ss_as_string'; | |
| "StringScanner" + | |
| ss_at_end_of_string.(ss).if { | |
| "fin" | |
| } { | |
| "%/%".format(ss['pos'], ss_pr_eos_pos.(ss)) + | |
| ss_at_beginning_of_string.(ss).if { | |
| "@" + ss_pr_after_pos.(ss).quote | |
| } { | |
| ss_pr_before_pos.(ss).quote + "@" + ss_pr_after_pos.(ss).quote | |
| } | |
| } | |
| }; | |
| /* | |
| stringscanner implementation (considered private) | |
| */ | |
| var | |
| ss_pr_find_regexp_directly_after_pos = | |
| { |ss, regexp| | |
| // TODO var funcName = 'ss_pr_find_regexp_directly_after_pos'; | |
| var match_data; | |
| match_data = ss_pr_find_first_regexp.(ss, ss['str'], regexp, ss['pos']); | |
| match_data.notNil.if { | |
| if (match_data[0] == ss['pos']) { | |
| match_data[1] | |
| } { nil } | |
| } { nil } | |
| }; | |
| var | |
| ss_pr_find_first_regexp_after_pos = | |
| { |ss, regexp| | |
| // TODO var funcName = 'ss_pr_find_first_regexp_after_pos'; | |
| var match_data; | |
| match_data = ss_pr_find_first_regexp.(ss, ss['str'], regexp, ss['pos']); | |
| match_data.notNil.if { [match_data[0]-ss['pos'], match_data[1]] } { nil } | |
| }; | |
| var | |
| ss_pr_find_first_regexp = | |
| { |ss, str, regexp, offset| | |
| // TODO var funcName = 'ss_pr_find_first_regexp'; | |
| str.findRegexp(regexp, ss['pos']).first | |
| }; | |
| var | |
| ss_pr_before_pos = | |
| { |ss| | |
| // TODO var funcName = 'ss_pr_before_pos'; | |
| var start = max(0, ss['pos']-ss['peekLength']), | |
| end = ss['pos']-1; | |
| if (start <= 0) {""} {"..."} ++ ss['str'][start..end].asString | |
| }; | |
| var | |
| ss_pr_after_pos = | |
| { |ss| | |
| // TODO var funcName = 'ss_pr_after_pos'; | |
| var start = ss['pos'], | |
| end = min(ss['str'].size-1, ss['pos']+ss['peekLength']-1); | |
| ss['str'][start..end].asString ++ if (end == (ss['str'].size-1)) {""} {"..."} | |
| }; | |
| var | |
| ss_pr_eos_pos = | |
| { |ss| | |
| // TODO var funcName = 'ss_pr_eos_pos'; | |
| ss['str'].size; | |
| }; | |
| /* | |
| assertions | |
| */ | |
| var | |
| assert_equal = | |
| { |a, b| | |
| if (a != b) { | |
| Error("assertion failed, expected a == b, actual % != %".format(a, b)).throw; | |
| }; | |
| }; | |
| var | |
| assert_true = | |
| { |a| | |
| if (a != true) { | |
| Error("assertion failed, expected a == true, actual % != true".format(a)).throw; | |
| }; | |
| }; | |
| var | |
| assert_false = | |
| { |a| | |
| if (a != false) { | |
| Error("assertion failed, expected a == false, actual % != false".format(a)).throw; | |
| }; | |
| }; | |
| run_tests.value; | |
| repl.value; | |
| 'ok' | |
| ) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment