mirrors
/
janet
mirror of https://github.com/janet-lang/janet
1
0
Fork 0
Code Issues 1 Releases Wiki Activity

Change format for declaring flexible arity functions.

This commit is contained in:
Calvin Rose 2018-11-25 14:03:00 -05:00
parent 5b3fc3d2cc
commit d4ee760b3e
8 changed files with 142 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
examples/classes.janet Normal file
View File

@ -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)))

2
examples/hello.janet
View File

@ -1,5 +1,3 @@
# Prints hello # Prints hello
(import examples.3sum)
(print "hello, world!") (print "hello, world!")

57
src/core/core.janet
View File

@ -21,18 +21,16 @@
(fn recur [i] (fn recur [i]
(def {i ith} more) (def {i ith} more)
(def t (type ith)) (def t (type ith))
(def tuple? (= t :tuple)) (if (= t :tuple)
(def array? (= t :array))
(if (if tuple? tuple? array?)
i i
(do (do
(if (= (type ith) :string) (if (= t :string)
(:= docstr ith) (:= docstr ith)
(array.push modifiers ith)) (array.push modifiers ith))
(if (< i len) (recur (+ i 1))))))) (if (< i len) (recur (+ i 1)))))))
(def start (fstart 0)) (def start (fstart 0))
(def args (get more start)) (def args (get more start))
# Add arguments to definition # Add function signature to docstring
(var index 0) (var index 0)
(def arglen (length args)) (def arglen (length args))
(def buf (buffer "(" name)) (def buf (buffer "(" name))
@ -49,22 +47,22 @@
(defn defmacro :macro (defn defmacro :macro
"Define a macro." "Define a macro."
[name & more] [name & more]
(apply defn (array.concat @[name :macro] more))) (apply defn name :macro more))
(defmacro defmacro- (defmacro defmacro-
"Define a private macro that will not be exported." "Define a private macro that will not be exported."
[name & more] [name & more]
(tuple.slice (array.concat @['defmacro name :private] more) 0)) (apply defn name :macro :private more))
(defmacro defn- (defmacro defn-
"Define a private function that will not be exported." "Define a private function that will not be exported."
[name & more] [name & more]
(tuple.slice (array.concat @['defn name :private] more) 0)) (apply defn name :private more))
(defmacro def- (defmacro def-
"Define a private value that will not be exported." "Define a private value that will not be exported."
[name & more] [name & more]
(tuple.slice (array.concat @['def name :private] more) 0)) (tuple.slice (array.concat @['def name :private] more)))
(defn defglobal (defn defglobal
"Dynamically create a global def." "Dynamically create a global def."
@ -290,7 +288,7 @@
(if (not= :tuple (type head)) (if (not= :tuple (type head))
(error "expected tuple for loop head")) (error "expected tuple for loop head"))
(defn doone (defn doone
@[i preds] [i preds &]
(default preds @['and]) (default preds @['and])
(if (>= i len) (if (>= i len)
(tuple.prepend body 'do) (tuple.prepend body 'do)
@ -419,7 +417,8 @@
that yields all values inside the loop in order. See loop for details." that yields all values inside the loop in order. See loop for details."
[head & body] [head & body]
(tuple fiber.new (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] (defn sum [xs]
(var accum 0) (var accum 0)
@ -432,15 +431,15 @@
accum) accum)
(defmacro coro (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] [& body]
(tuple fiber.new (apply tuple 'fn @[] body))) (tuple fiber.new (apply tuple 'fn [tuple '&] body)))
(defmacro if-let (defmacro if-let
"Takes the first one or two forms in a vector and if both are true binds "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 all the forms with let and evaluates the first expression else
evaluates the second" evaluates the second"
@[bindings tru fal] [bindings tru fal &]
(def len (length bindings)) (def len (length bindings))
(if (zero? len) (error "expected at least 1 binding")) (if (zero? len) (error "expected at least 1 binding"))
(if (odd? len) (error "expected an even number of bindings")) (if (odd? len) (error "expected an even number of bindings"))
@ -547,12 +546,12 @@
(sort-help a (+ piv 1) hi by)) (sort-help a (+ piv 1) hi by))
a) a)
(fn @[a by] (fn [a by &]
(sort-help a 0 (- (length a) 1) (or by order<))))) (sort-help a 0 (- (length a) 1) (or by order<)))))
(defn sorted (defn sorted
"Returns the sorted version of an indexed data structure." "Returns the sorted version of an indexed data structure."
@[ind by t] [ind by t &]
(def sa (sort (array.slice ind 0) by)) (def sa (sort (array.slice ind 0) by))
(if (= :tuple (or t (type ind))) (if (= :tuple (or t (type ind)))
(tuple.slice sa 0) (tuple.slice sa 0)
@ -561,7 +560,7 @@
(defn reduce (defn reduce
"Reduce, also know as fold-left in many languages, transforms "Reduce, also know as fold-left in many languages, transforms
an indexed type (array, tuple) with a function to produce a value." an indexed type (array, tuple) with a function to produce a value."
@[f init ind] [f init ind &]
(var res init) (var res init)
(loop [x :in ind] (loop [x :in ind]
(:= res (f res x))) (:= res (f res x)))
@ -621,7 +620,7 @@
"Map a function over every element in an array or tuple and "Map a function over every element in an array or tuple and
use array to concatenate the results. Returns the type given use array to concatenate the results. Returns the type given
as the third argument, or same type as the input indexed structure." as the third argument, or same type as the input indexed structure."
@[f ind t] [f ind t &]
(def res @[]) (def res @[])
(loop [x :in ind] (loop [x :in ind]
(array.concat res (f x))) (array.concat res (f x)))
@ -633,7 +632,7 @@
"Given a predicate, take only elements from an array or tuple for "Given a predicate, take only elements from an array or tuple for
which (pred element) is truthy. Returns the type given as the which (pred element) is truthy. Returns the type given as the
third argument, or the same type as the input indexed structure." third argument, or the same type as the input indexed structure."
@[pred ind t] [pred ind t &]
(def res @[]) (def res @[])
(loop [item :in ind] (loop [item :in ind]
(if (pred item) (if (pred item)
@ -796,7 +795,7 @@ value, one key will be ignored."
(defn zipcoll (defn zipcoll
"Creates an table or tuple from two arrays/tuples. If a third argument of "Creates an table or tuple from two arrays/tuples. If a third argument of
:struct is given result is struct else is table." :struct is given result is struct else is table."
@[keys vals t] [keys vals t &]
(def res @{}) (def res @{})
(def lk (length keys)) (def lk (length keys))
(def lv (length vals)) (def lv (length vals))
@ -1070,7 +1069,7 @@ value, one key will be ignored."
### ###
(defn make-env (defn make-env
@[parent] [parent &]
(def parent (if parent parent _env)) (def parent (if parent parent _env))
(def newenv (table.setproto @{} parent)) (def newenv (table.setproto @{} parent))
(put newenv '_env @{:value newenv :private true (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 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 pass a function that reads line from stdin to chunks, and print to
onvalue." onvalue."
@[env chunks onvalue onerr where] [env chunks onvalue onerr where &]
# Are we done yet? # Are we done yet?
(var going true) (var going true)
@ -1131,7 +1130,7 @@ value, one key will be ignored."
(var good true) (var good true)
(def f (def f
(fiber.new (fiber.new
(fn @[] (fn [&]
(def res (compile source env where)) (def res (compile source env where))
(if (= (type res) :function) (if (= (type res) :function)
(res) (res)
@ -1163,7 +1162,7 @@ value, one key will be ignored."
env) env)
(defn default-error-handler (defn default-error-handler
@[source t x f] [source t x f &]
(file.write stderr (file.write stderr
(string t " error in " source ": ") (string t " error in " source ": ")
(if (bytes? x) x (string.pretty x)) (if (bytes? x) x (string.pretty x))
@ -1282,7 +1281,7 @@ value, one key will be ignored."
(def cache @{}) (def cache @{})
(def loading @{}) (def loading @{})
(fn require @[path args] (fn require [path args &]
(when (get loading path) (when (get loading path)
(error (string "circular dependency: module " path " is loading"))) (error (string "circular dependency: module " path " is loading")))
(def {:exit exit-on-error} (or args {})) (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)) (defn chunks [buf _] (file.read f 1024 buf))
(run-context newenv chunks identity (run-context newenv chunks identity
(if exit-on-error (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) default-error-handler)
path) path)
(file.close f)) (file.close f))
@ -1344,9 +1343,9 @@ value, one key will be ignored."
(defn repl (defn repl
"Run a repl. The first parameter is an optional function to call to "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." get a chunk of source code. Should return nil for end of file."
@[getchunk onvalue onerr] [getchunk onvalue onerr &]
(def newenv (make-env)) (def newenv (make-env))
(default getchunk (fn @[buf] (default getchunk (fn [buf &]
(file.read stdin :line buf))) (file.read stdin :line buf)))
(def buf @"") (def buf @"")
(default onvalue (fn [x] (default onvalue (fn [x]
@ -1358,7 +1357,7 @@ value, one key will be ignored."
(defn all-symbols (defn all-symbols
"Get all symbols available in the current environment." "Get all symbols available in the current environment."
@[env] [env &]
(default env *env*) (default env *env*)
(def envs @[]) (def envs @[])
(do (var e env) (while e (array.push envs e) (:= e (table.getproto e)))) (do (var e env) (while e (array.push envs e) (:= e (table.getproto e))))

67
src/core/specials.c
View File

@ -469,14 +469,18 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
JanetCompiler *c = opts.compiler; JanetCompiler *c = opts.compiler;
JanetFuncDef *def; JanetFuncDef *def;
JanetSlot ret; JanetSlot ret;
Janet head, paramv; Janet head;
JanetScope fnscope; JanetScope fnscope;
int32_t paramcount, argi, parami, arity, defindex; int32_t paramcount, argi, parami, arity, defindex, i;
JanetFopts subopts = janetc_fopts_default(c); JanetFopts subopts = janetc_fopts_default(c);
const Janet *params; const Janet *params;
const char *errmsg = NULL; const char *errmsg = NULL;
int varargs = 0;
/* Function flags */
int vararg = 0;
int fixarity = 1;
int selfref = 0; int selfref = 0;
int seenamp = 0;
/* Begin function */ /* Begin function */
c->scope->flags |= JANET_SCOPE_CLOSURE; 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 */ /* Read function parameters */
parami = 0; parami = 0;
arity = 0;
head = argv[0]; head = argv[0];
if (janet_checktype(head, JANET_SYMBOL)) { if (janet_checktype(head, JANET_SYMBOL)) {
selfref = 1; selfref = 1;
parami = 1; parami = 1;
} }
if (parami >= argn) { if (parami >= argn || !janet_checktype(argv[parami], JANET_TUPLE)) {
errmsg = "expected function parameters"; errmsg = "expected function parameters";
goto error; goto error;
} }
paramv = argv[parami];
if (janet_indexed_view(paramv, &params, &paramcount)) { /* Compile function parameters */
int32_t i; params = janet_unwrap_tuple(argv[parami]);
for (i = 0; i < paramcount; i++) { paramcount = janet_tuple_length(params);
Janet param = params[i]; arity = paramcount;
if (janet_checktype(param, JANET_SYMBOL)) { for (i = 0; i < paramcount; i++) {
/* Check for varargs */ Janet param = params[i];
if (0 == janet_cstrcmp(janet_unwrap_symbol(param), "&")) { if (janet_checktype(param, JANET_SYMBOL)) {
if (i != paramcount - 2) { /* Check for varargs and unfixed arity */
errmsg = "variable argument symbol in unexpected location"; if ((!seenamp) &&
goto error; (0 == janet_cstrcmp(janet_unwrap_symbol(param), "&"))) {
} seenamp = 1;
varargs = 1; fixarity = 0;
if (i == paramcount - 1) {
arity--; 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 { } 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 */ /* Check for self ref */
@ -547,19 +553,14 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
/* Build function */ /* Build function */
def = janetc_pop_funcdef(c); def = janetc_pop_funcdef(c);
def->arity = arity; def->arity = arity;
if (fixarity) def->flags |= JANET_FUNCDEF_FLAG_FIXARITY;
/* Tuples indicated fixed arity, arrays indicate flexible arity */ if (vararg) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
/* 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 (selfref) def->name = janet_unwrap_symbol(head); if (selfref) def->name = janet_unwrap_symbol(head);
defindex = janetc_addfuncdef(c, def); defindex = janetc_addfuncdef(c, def);
/* Ensure enough slots for vararg function. */ /* 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 */ /* Instantiate closure */
ret = janetc_gettarget(opts); ret = janetc_gettarget(opts);

16
src/mainclient/init.janet
View File

@ -10,7 +10,7 @@
# Flag handlers # Flag handlers
(def handlers :private (def handlers :private
{"h" (fn @[] {"h" (fn [&]
(print "usage: " (get process.args 0) " [options] scripts...") (print "usage: " (get process.args 0) " [options] scripts...")
(print (print
`Options are: `Options are:
@ -23,17 +23,17 @@
-- Stop handling options`) -- Stop handling options`)
(os.exit 0) (os.exit 0)
1) 1)
"v" (fn @[] (print janet.version) (os.exit 0) 1) "v" (fn [&] (print janet.version) (os.exit 0) 1)
"s" (fn @[] (:= *raw-stdin* true) (:= *should-repl* true) 1) "s" (fn [&] (:= *raw-stdin* true) (:= *should-repl* true) 1)
"r" (fn @[] (:= *should-repl* true) 1) "r" (fn [&] (:= *should-repl* true) 1)
"p" (fn @[] (:= *exit-on-error* false) 1) "p" (fn [&] (:= *exit-on-error* false) 1)
"-" (fn @[] (:= *handleopts* false) 1) "-" (fn [&] (:= *handleopts* false) 1)
"e" (fn @[i] "e" (fn [i &]
(:= *no-file* false) (:= *no-file* false)
(eval (get process.args (+ i 1))) (eval (get process.args (+ i 1)))
2)}) 2)})
(defn- dohandler @[n i] (defn- dohandler [n i &]
(def h (get handlers n)) (def h (get handlers n))
(if h (h i) (do (print "unknown flag -" n) ((get handlers "h"))))) (if h (h i) (do (print "unknown flag -" n) ((get handlers "h")))))

2
src/webclient/webinit.janet
View File

@ -2,7 +2,7 @@
(print (string "Janet " janet.version " Copyright (C) 2017-2018 Calvin Rose")) (print (string "Janet " janet.version " Copyright (C) 2017-2018 Calvin Rose"))
(fiber.new (fiber.new
(fn @[] (fn [&]
(repl (fn [buf p] (repl (fn [buf p]
(def [line] (parser.where p)) (def [line] (parser.where p))
(def prompt (string "janet:" line ":" (parser.state p) "> ")) (def prompt (string "janet:" line ":" (parser.state p) "> "))

2
test/suite0.janet
View File

@ -164,7 +164,7 @@
# yield tests # 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 (= 1 (resume t)) "initial transfer to new fiber")
(assert (= 2 (resume t)) "second transfer to fiber") (assert (= 2 (resume t)) "second transfer to fiber")

6
test/suite1.janet
View File

@ -76,9 +76,9 @@
# More fiber semantics # More fiber semantics
(var myvar 0) (var myvar 0)
(defn fiberstuff @[] (defn fiberstuff [&]
(++ myvar) (++ myvar)
(def f (fiber.new (fn @[] (++ myvar) (debug) (++ myvar)))) (def f (fiber.new (fn [&] (++ myvar) (debug) (++ myvar))))
(resume f) (resume f)
(++ myvar)) (++ myvar))
@ -169,7 +169,7 @@
(testmarsh (fn thing [x] (+ 11 x x 30)) "marshal function 3") (testmarsh (fn thing [x] (+ 11 x x 30)) "marshal function 3")
(testmarsh mapa "marshal function 4") (testmarsh mapa "marshal function 4")
(testmarsh reduce "marshal function 5") (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 # Large functions
(def manydefs (fora [i :range [0 300]] (tuple 'def (gensym) (string "value_" i)))) (def manydefs (fora [i :range [0 300]] (tuple 'def (gensym) (string "value_" i))))