mirror of
				https://github.com/janet-lang/janet
				synced 2025-10-31 07:33:01 +00:00 
			
		
		
		
	Change format for declaring flexible arity functions.
This commit is contained in:
		| @@ -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)))) | ||||
|   | ||||
| @@ -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); | ||||
|   | ||||
| @@ -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"))))) | ||||
|  | ||||
|   | ||||
| @@ -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) "> ")) | ||||
|   | ||||
		Reference in New Issue
	
	Block a user
	 Calvin Rose
					Calvin Rose