From d4ee760b3e4d0c557574a3ef16a372c14ff689e5 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 25 Nov 2018 14:03:00 -0500 Subject: [PATCH] Change format for declaring flexible arity functions. --- examples/classes.janet | 67 +++++++++++++++++++++++++++++++++++++ examples/hello.janet | 2 -- src/core/core.janet | 57 ++++++++++++++++--------------- src/core/specials.c | 67 +++++++++++++++++++------------------ src/mainclient/init.janet | 16 ++++----- src/webclient/webinit.janet | 2 +- test/suite0.janet | 2 +- test/suite1.janet | 6 ++-- 8 files changed, 142 insertions(+), 77 deletions(-) create mode 100644 examples/classes.janet diff --git a/examples/classes.janet b/examples/classes.janet new file mode 100644 index 00000000..5a420845 --- /dev/null +++ b/examples/classes.janet @@ -0,0 +1,67 @@ +# Classes need to: +# 1. Construct Objects +# 2. Keep metadata of objects +# 3. Support Method Lookup given a method signature +# 4. Add Methods +# 5. Keep around state + +(defn- parse-signature + "Turn a signature into a (method, object) pair." + [signature] + (when (not (symbol? signature)) (error "expected method signature")) + (def parts (string.split ":" signature)) + (def self (symbol (get parts 0))) + (def method (apply symbol (tuple.slice parts 1))) + (tuple (tuple 'quote method) self)) + +(defn- add-self-to-body + "Take a function definition and add the parameter 'self' + to the declaration." + [body] + (def args-index (find-index tuple? body)) + (def bodya (apply array body)) + (put bodya args-index (tuple.prepend (get bodya args-index) 'self)) + bodya) + +(defmacro call + "Call a method." + [signature & args] + (def [method self] (parse-signature signature)) + (apply tuple (tuple get self method) self args)) + +(def :macro $ call) + +(defn class + "Create a new class." + [& args] + (def classobj (apply table args)) + + # Set up super class + (def super (get classobj :super)) + (when super + (put classobj :super nil) + (table.setproto classobj super)) + + classobj) + +(defn new + "Create a new instance of a class." + [class & args] + (def obj (table.setproto @{} class)) + (def init (get class 'init)) + (when init (apply init obj args)) + obj) + +(defmacro defmethod + "Defines a method for a class." + [signature & args] + (def [method self] (parse-signature signature)) + (def newargs (add-self-to-body args)) + (tuple put self method (tuple.prepend newargs signature 'fn))) + +(defmacro defclass + "Defines a new class." + [name & body] + (tuple 'def name + (tuple.prepend body class))) + diff --git a/examples/hello.janet b/examples/hello.janet index cad00e8f..b27f5127 100644 --- a/examples/hello.janet +++ b/examples/hello.janet @@ -1,5 +1,3 @@ # Prints hello -(import examples.3sum) - (print "hello, world!") diff --git a/src/core/core.janet b/src/core/core.janet index 5486147b..340a892b 100644 --- a/src/core/core.janet +++ b/src/core/core.janet @@ -21,18 +21,16 @@ (fn recur [i] (def {i ith} more) (def t (type ith)) - (def tuple? (= t :tuple)) - (def array? (= t :array)) - (if (if tuple? tuple? array?) + (if (= t :tuple) i (do - (if (= (type ith) :string) + (if (= t :string) (:= docstr ith) (array.push modifiers ith)) (if (< i len) (recur (+ i 1))))))) (def start (fstart 0)) (def args (get more start)) - # Add arguments to definition + # Add function signature to docstring (var index 0) (def arglen (length args)) (def buf (buffer "(" name)) @@ -49,22 +47,22 @@ (defn defmacro :macro "Define a macro." [name & more] - (apply defn (array.concat @[name :macro] more))) + (apply defn name :macro more)) (defmacro defmacro- "Define a private macro that will not be exported." [name & more] - (tuple.slice (array.concat @['defmacro name :private] more) 0)) + (apply defn name :macro :private more)) (defmacro defn- "Define a private function that will not be exported." [name & more] - (tuple.slice (array.concat @['defn name :private] more) 0)) + (apply defn name :private more)) (defmacro def- "Define a private value that will not be exported." [name & more] - (tuple.slice (array.concat @['def name :private] more) 0)) + (tuple.slice (array.concat @['def name :private] more))) (defn defglobal "Dynamically create a global def." @@ -290,7 +288,7 @@ (if (not= :tuple (type head)) (error "expected tuple for loop head")) (defn doone - @[i preds] + [i preds &] (default preds @['and]) (if (>= i len) (tuple.prepend body 'do) @@ -419,7 +417,8 @@ that yields all values inside the loop in order. See loop for details." [head & body] (tuple fiber.new - (tuple 'fn @[] (tuple 'loop head (tuple yield (tuple.prepend body 'do)))))) + (tuple 'fn [tuple '&] + (tuple 'loop head (tuple yield (tuple.prepend body 'do)))))) (defn sum [xs] (var accum 0) @@ -432,15 +431,15 @@ accum) (defmacro coro - "A wrapper for making fibers. Same as (fiber.new (fn @[] ...body))." + "A wrapper for making fibers. Same as (fiber.new (fn [&] ...body))." [& body] - (tuple fiber.new (apply tuple 'fn @[] body))) + (tuple fiber.new (apply tuple 'fn [tuple '&] body))) (defmacro if-let "Takes the first one or two forms in a vector and if both are true binds all the forms with let and evaluates the first expression else evaluates the second" - @[bindings tru fal] + [bindings tru fal &] (def len (length bindings)) (if (zero? len) (error "expected at least 1 binding")) (if (odd? len) (error "expected an even number of bindings")) @@ -547,12 +546,12 @@ (sort-help a (+ piv 1) hi by)) a) - (fn @[a by] + (fn [a by &] (sort-help a 0 (- (length a) 1) (or by order<))))) (defn sorted "Returns the sorted version of an indexed data structure." - @[ind by t] + [ind by t &] (def sa (sort (array.slice ind 0) by)) (if (= :tuple (or t (type ind))) (tuple.slice sa 0) @@ -561,7 +560,7 @@ (defn reduce "Reduce, also know as fold-left in many languages, transforms an indexed type (array, tuple) with a function to produce a value." - @[f init ind] + [f init ind &] (var res init) (loop [x :in ind] (:= res (f res x))) @@ -621,7 +620,7 @@ "Map a function over every element in an array or tuple and use array to concatenate the results. Returns the type given as the third argument, or same type as the input indexed structure." - @[f ind t] + [f ind t &] (def res @[]) (loop [x :in ind] (array.concat res (f x))) @@ -633,7 +632,7 @@ "Given a predicate, take only elements from an array or tuple for which (pred element) is truthy. Returns the type given as the third argument, or the same type as the input indexed structure." - @[pred ind t] + [pred ind t &] (def res @[]) (loop [item :in ind] (if (pred item) @@ -796,7 +795,7 @@ value, one key will be ignored." (defn zipcoll "Creates an table or tuple from two arrays/tuples. If a third argument of :struct is given result is struct else is table." - @[keys vals t] + [keys vals t &] (def res @{}) (def lk (length keys)) (def lv (length vals)) @@ -1070,7 +1069,7 @@ value, one key will be ignored." ### (defn make-env - @[parent] + [parent &] (def parent (if parent parent _env)) (def newenv (table.setproto @{} parent)) (put newenv '_env @{:value newenv :private true @@ -1089,7 +1088,7 @@ value, one key will be ignored." This function can be used to implement a repl very easily, simply pass a function that reads line from stdin to chunks, and print to onvalue." - @[env chunks onvalue onerr where] + [env chunks onvalue onerr where &] # Are we done yet? (var going true) @@ -1131,7 +1130,7 @@ value, one key will be ignored." (var good true) (def f (fiber.new - (fn @[] + (fn [&] (def res (compile source env where)) (if (= (type res) :function) (res) @@ -1163,7 +1162,7 @@ value, one key will be ignored." env) (defn default-error-handler - @[source t x f] + [source t x f &] (file.write stderr (string t " error in " source ": ") (if (bytes? x) x (string.pretty x)) @@ -1282,7 +1281,7 @@ value, one key will be ignored." (def cache @{}) (def loading @{}) - (fn require @[path args] + (fn require [path args &] (when (get loading path) (error (string "circular dependency: module " path " is loading"))) (def {:exit exit-on-error} (or args {})) @@ -1300,7 +1299,7 @@ value, one key will be ignored." (defn chunks [buf _] (file.read f 1024 buf)) (run-context newenv chunks identity (if exit-on-error - (fn @[a b c d] (default-error-handler a b c d) (os.exit 1)) + (fn [a b c d &] (default-error-handler a b c d) (os.exit 1)) default-error-handler) path) (file.close f)) @@ -1344,9 +1343,9 @@ value, one key will be ignored." (defn repl "Run a repl. The first parameter is an optional function to call to get a chunk of source code. Should return nil for end of file." - @[getchunk onvalue onerr] + [getchunk onvalue onerr &] (def newenv (make-env)) - (default getchunk (fn @[buf] + (default getchunk (fn [buf &] (file.read stdin :line buf))) (def buf @"") (default onvalue (fn [x] @@ -1358,7 +1357,7 @@ value, one key will be ignored." (defn all-symbols "Get all symbols available in the current environment." - @[env] + [env &] (default env *env*) (def envs @[]) (do (var e env) (while e (array.push envs e) (:= e (table.getproto e)))) diff --git a/src/core/specials.c b/src/core/specials.c index 406041ee..ec75a255 100644 --- a/src/core/specials.c +++ b/src/core/specials.c @@ -469,14 +469,18 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) { JanetCompiler *c = opts.compiler; JanetFuncDef *def; JanetSlot ret; - Janet head, paramv; + Janet head; JanetScope fnscope; - int32_t paramcount, argi, parami, arity, defindex; + int32_t paramcount, argi, parami, arity, defindex, i; JanetFopts subopts = janetc_fopts_default(c); const Janet *params; const char *errmsg = NULL; - int varargs = 0; + + /* Function flags */ + int vararg = 0; + int fixarity = 1; int selfref = 0; + int seenamp = 0; /* Begin function */ c->scope->flags |= JANET_SCOPE_CLOSURE; @@ -489,41 +493,43 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) { /* Read function parameters */ parami = 0; - arity = 0; head = argv[0]; if (janet_checktype(head, JANET_SYMBOL)) { selfref = 1; parami = 1; } - if (parami >= argn) { + if (parami >= argn || !janet_checktype(argv[parami], JANET_TUPLE)) { errmsg = "expected function parameters"; goto error; } - paramv = argv[parami]; - if (janet_indexed_view(paramv, ¶ms, ¶mcount)) { - int32_t i; - for (i = 0; i < paramcount; i++) { - Janet param = params[i]; - if (janet_checktype(param, JANET_SYMBOL)) { - /* Check for varargs */ - if (0 == janet_cstrcmp(janet_unwrap_symbol(param), "&")) { - if (i != paramcount - 2) { - errmsg = "variable argument symbol in unexpected location"; - goto error; - } - varargs = 1; + + /* Compile function parameters */ + params = janet_unwrap_tuple(argv[parami]); + paramcount = janet_tuple_length(params); + arity = paramcount; + for (i = 0; i < paramcount; i++) { + Janet param = params[i]; + if (janet_checktype(param, JANET_SYMBOL)) { + /* Check for varargs and unfixed arity */ + if ((!seenamp) && + (0 == janet_cstrcmp(janet_unwrap_symbol(param), "&"))) { + seenamp = 1; + fixarity = 0; + if (i == paramcount - 1) { arity--; - continue; + } else if (i == paramcount - 2) { + vararg = 1; + arity -= 2; + } else { + errmsg = "variable argument symbol in unexpected location"; + goto error; } - janetc_nameslot(c, janet_unwrap_symbol(param), janetc_farslot(c)); } else { - destructure(c, param, janetc_farslot(c), defleaf, NULL); + janetc_nameslot(c, janet_unwrap_symbol(param), janetc_farslot(c)); } - arity++; + } else { + destructure(c, param, janetc_farslot(c), defleaf, NULL); } - } else { - errmsg = "expected function parameters"; - goto error; } /* Check for self ref */ @@ -547,19 +553,14 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) { /* Build function */ def = janetc_pop_funcdef(c); def->arity = arity; - - /* Tuples indicated fixed arity, arrays indicate flexible arity */ - /* TODO - revisit this */ - if (varargs) - def->flags |= JANET_FUNCDEF_FLAG_VARARG; - else if (janet_checktype(paramv, JANET_TUPLE)) - def->flags |= JANET_FUNCDEF_FLAG_FIXARITY; + if (fixarity) def->flags |= JANET_FUNCDEF_FLAG_FIXARITY; + if (vararg) def->flags |= JANET_FUNCDEF_FLAG_VARARG; if (selfref) def->name = janet_unwrap_symbol(head); defindex = janetc_addfuncdef(c, def); /* Ensure enough slots for vararg function. */ - if (arity + varargs > def->slotcount) def->slotcount = arity + varargs; + if (arity + vararg > def->slotcount) def->slotcount = arity + vararg; /* Instantiate closure */ ret = janetc_gettarget(opts); diff --git a/src/mainclient/init.janet b/src/mainclient/init.janet index 6d870a53..391776f4 100644 --- a/src/mainclient/init.janet +++ b/src/mainclient/init.janet @@ -10,7 +10,7 @@ # Flag handlers (def handlers :private - {"h" (fn @[] + {"h" (fn [&] (print "usage: " (get process.args 0) " [options] scripts...") (print `Options are: @@ -23,17 +23,17 @@ -- Stop handling options`) (os.exit 0) 1) - "v" (fn @[] (print janet.version) (os.exit 0) 1) - "s" (fn @[] (:= *raw-stdin* true) (:= *should-repl* true) 1) - "r" (fn @[] (:= *should-repl* true) 1) - "p" (fn @[] (:= *exit-on-error* false) 1) - "-" (fn @[] (:= *handleopts* false) 1) - "e" (fn @[i] + "v" (fn [&] (print janet.version) (os.exit 0) 1) + "s" (fn [&] (:= *raw-stdin* true) (:= *should-repl* true) 1) + "r" (fn [&] (:= *should-repl* true) 1) + "p" (fn [&] (:= *exit-on-error* false) 1) + "-" (fn [&] (:= *handleopts* false) 1) + "e" (fn [i &] (:= *no-file* false) (eval (get process.args (+ i 1))) 2)}) - (defn- dohandler @[n i] + (defn- dohandler [n i &] (def h (get handlers n)) (if h (h i) (do (print "unknown flag -" n) ((get handlers "h"))))) diff --git a/src/webclient/webinit.janet b/src/webclient/webinit.janet index dca86a6c..46af1f1d 100644 --- a/src/webclient/webinit.janet +++ b/src/webclient/webinit.janet @@ -2,7 +2,7 @@ (print (string "Janet " janet.version " Copyright (C) 2017-2018 Calvin Rose")) (fiber.new - (fn @[] + (fn [&] (repl (fn [buf p] (def [line] (parser.where p)) (def prompt (string "janet:" line ":" (parser.state p) "> ")) diff --git a/test/suite0.janet b/test/suite0.janet index 8c4e2ae9..c9b80857 100644 --- a/test/suite0.janet +++ b/test/suite0.janet @@ -164,7 +164,7 @@ # yield tests -(def t (fiber.new (fn @[] (yield 1) (yield 2) 3))) +(def t (fiber.new (fn [&] (yield 1) (yield 2) 3))) (assert (= 1 (resume t)) "initial transfer to new fiber") (assert (= 2 (resume t)) "second transfer to fiber") diff --git a/test/suite1.janet b/test/suite1.janet index dff646d7..172e7df6 100644 --- a/test/suite1.janet +++ b/test/suite1.janet @@ -76,9 +76,9 @@ # More fiber semantics (var myvar 0) -(defn fiberstuff @[] +(defn fiberstuff [&] (++ myvar) - (def f (fiber.new (fn @[] (++ myvar) (debug) (++ myvar)))) + (def f (fiber.new (fn [&] (++ myvar) (debug) (++ myvar)))) (resume f) (++ myvar)) @@ -169,7 +169,7 @@ (testmarsh (fn thing [x] (+ 11 x x 30)) "marshal function 3") (testmarsh mapa "marshal function 4") (testmarsh reduce "marshal function 5") -(testmarsh (fiber.new (fn @[] (yield 1) 2)) "marshal simple fiber") +(testmarsh (fiber.new (fn [&] (yield 1) 2)) "marshal simple fiber") # Large functions (def manydefs (fora [i :range [0 300]] (tuple 'def (gensym) (string "value_" i))))