kanaka/mal
1
1
Fork 0
mirror of https://github.com/kanaka/mal.git synced 2024-11-13 01:43:50 +03:00
Code Issues Projects Releases Wiki Activity

common-lisp, es6, guile, java, mal: Add number?, fn?, macro?

Browse Source
This commit is contained in:
Vasilij Schneidermann 2017-10-17 01:29:08 +02:00
parent c1709fad0b
commit 85657c9632
17 changed files with 113 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
common-lisp/src/core.lisp
View File

@ -174,6 +174,9 @@
(defmal false? (value)
(wrap-boolean (and (mal-boolean-p value) (not (mal-data-value value)))))
(defmal number? (value)
(wrap-boolean (mal-number-p value)))
(defmal symbol (string)
(make-mal-symbol (mal-data-value string)))
@ -194,6 +197,15 @@
(defmal vector? (value)
(wrap-boolean (mal-vector-p value)))
(defmal fn? (value)
(wrap-boolean (or (mal-builtin-fn-p value)
(and (mal-fn-p value)
(not (cdr (assoc :is-macro (mal-data-attrs value))))))))
(defmal macro? (value)
(wrap-boolean (and (mal-fn-p value)
(cdr (assoc :is-macro (mal-data-attrs value))))))
(defmal hash-map (&rest elements)
(let ((hash-map (make-mal-value-hash-table)))
(loop for (key value) on elements

12
common-lisp/src/step5_tco.lisp
View File

@ -102,9 +102,9 @@
(mal-eval body (env:create-mal-env :parent env
:binds (listify (mal-data-value arglist))
:exprs args)))
:attrs (list (cons 'params arglist)
(cons 'ast body)
(cons 'env env))))))
:attrs (list (cons :params arglist)
(cons :ast body)
(cons :env env))))))
(t (let* ((evaluated-list (eval-ast ast env))
(function (car evaluated-list)))
@ -113,11 +113,11 @@
(return (apply (mal-data-value function)
(cdr evaluated-list)))
(let* ((attrs (mal-data-attrs function)))
(setf ast (cdr (assoc 'ast attrs))
env (env:create-mal-env :parent (cdr (assoc 'env attrs))
(setf ast (cdr (assoc :ast attrs))
env (env:create-mal-env :parent (cdr (assoc :env attrs))
:binds (map 'list
#'identity
(mal-data-value (cdr (assoc 'params attrs))))
(mal-data-value (cdr (assoc :params attrs))))
:exprs (cdr evaluated-list)))))))))))))
(defun mal-print (expression)

12
common-lisp/src/step6_file.lisp
View File

@ -102,9 +102,9 @@
(mal-eval body (env:create-mal-env :parent env
:binds (listify (mal-data-value arglist))
:exprs args)))
:attrs (list (cons 'params arglist)
(cons 'ast body)
(cons 'env env))))))
:attrs (list (cons :params arglist)
(cons :ast body)
(cons :env env))))))
(t (let* ((evaluated-list (eval-ast ast env))
(function (car evaluated-list)))
@ -113,11 +113,11 @@
(return (apply (mal-data-value function)
(cdr evaluated-list)))
(let* ((attrs (mal-data-attrs function)))
(setf ast (cdr (assoc 'ast attrs))
env (env:create-mal-env :parent (cdr (assoc 'env attrs))
(setf ast (cdr (assoc :ast attrs))
env (env:create-mal-env :parent (cdr (assoc :env attrs))
:binds (map 'list
#'identity
(mal-data-value (cdr (assoc 'params attrs))))
(mal-data-value (cdr (assoc :params attrs))))
:exprs (cdr evaluated-list)))))))))))))
(defun mal-print (expression)

12
common-lisp/src/step7_quote.lisp
View File

@ -138,9 +138,9 @@
(mal-eval body (env:create-mal-env :parent env
:binds (listify (mal-data-value arglist))
:exprs args)))
:attrs (list (cons 'params arglist)
(cons 'ast body)
(cons 'env env))))))
:attrs (list (cons :params arglist)
(cons :ast body)
(cons :env env))))))
(t (let* ((evaluated-list (eval-ast ast env))
(function (car evaluated-list)))
@ -149,11 +149,11 @@
(return (apply (mal-data-value function)
(cdr evaluated-list)))
(let* ((attrs (mal-data-attrs function)))
(setf ast (cdr (assoc 'ast attrs))
env (env:create-mal-env :parent (cdr (assoc 'env attrs))
(setf ast (cdr (assoc :ast attrs))
env (env:create-mal-env :parent (cdr (assoc :env attrs))
:binds (map 'list
#'identity
(mal-data-value (cdr (assoc 'params attrs))))
(mal-data-value (cdr (assoc :params attrs))))
:exprs (cdr evaluated-list)))))))))))))
(defun mal-print (expression)

18
common-lisp/src/step8_macros.lisp
View File

@ -103,7 +103,7 @@
(env:find-env env func-symbol))))
(and func
(mal-fn-p func)
(cdr (assoc 'is-macro (mal-data-attrs func)))))))
(cdr (assoc :is-macro (mal-data-attrs func)))))))
(defun mal-macroexpand (ast env)
(loop
@ -144,7 +144,7 @@
(env:set-env env
(second forms)
(progn
(setf (cdr (assoc 'is-macro (mal-data-attrs value))) t)
(setf (cdr (assoc :is-macro (mal-data-attrs value))) t)
value))
(error 'invalid-function
:form value
@ -186,21 +186,21 @@
(mal-eval body (env:create-mal-env :parent env
:binds (listify (mal-data-value arglist))
:exprs args)))
:attrs (list (cons 'params arglist)
(cons 'ast body)
(cons 'env env)
(cons 'is-macro nil))))))
:attrs (list (cons :params arglist)
(cons :ast body)
(cons :env env)
(cons :is-macro nil))))))
(t (let* ((evaluated-list (eval-ast ast env))
(function (car evaluated-list)))
;; If first element is a mal function unwrap it
(cond ((mal-fn-p function)
(let* ((attrs (mal-data-attrs function)))
(setf ast (cdr (assoc 'ast attrs))
env (env:create-mal-env :parent (cdr (assoc 'env attrs))
(setf ast (cdr (assoc :ast attrs))
env (env:create-mal-env :parent (cdr (assoc :env attrs))
:binds (map 'list
#'identity
(mal-data-value (cdr (assoc 'params attrs))))
(mal-data-value (cdr (assoc :params attrs))))
:exprs (cdr evaluated-list)))))
((mal-builtin-fn-p function)
(return (apply (mal-data-value function)

18
common-lisp/src/step9_try.lisp
View File

@ -106,7 +106,7 @@
(env:find-env env func-symbol))))
(and func
(mal-fn-p func)
(cdr (assoc 'is-macro (mal-data-attrs func)))))))
(cdr (assoc :is-macro (mal-data-attrs func)))))))
(defun mal-macroexpand (ast env)
(loop
@ -147,7 +147,7 @@
(env:set-env env
(second forms)
(progn
(setf (cdr (assoc 'is-macro (mal-data-attrs value))) t)
(setf (cdr (assoc :is-macro (mal-data-attrs value))) t)
value))
(error 'invalid-function
:form value
@ -189,10 +189,10 @@
(mal-eval body (env:create-mal-env :parent env
:binds (listify (mal-data-value arglist))
:exprs args)))
:attrs (list (cons 'params arglist)
(cons 'ast body)
(cons 'env env)
(cons 'is-macro nil))))))
:attrs (list (cons :params arglist)
(cons :ast body)
(cons :env env)
(cons :is-macro nil))))))
((mal-data-value= mal-try* (first forms))
(handler-case
@ -214,11 +214,11 @@
;; If first element is a mal function unwrap it
(cond ((mal-fn-p function)
(let* ((attrs (mal-data-attrs function)))
(setf ast (cdr (assoc 'ast attrs))
env (env:create-mal-env :parent (cdr (assoc 'env attrs))
(setf ast (cdr (assoc :ast attrs))
env (env:create-mal-env :parent (cdr (assoc :env attrs))
:binds (map 'list
#'identity
(mal-data-value (cdr (assoc 'params attrs))))
(mal-data-value (cdr (assoc :params attrs))))
:exprs (cdr evaluated-list)))))
((mal-builtin-fn-p function)
(return (apply (mal-data-value function)

18
common-lisp/src/stepA_mal.lisp
View File

@ -105,7 +105,7 @@
(env:find-env env func-symbol))))
(and func
(mal-fn-p func)
(cdr (assoc 'is-macro (mal-data-attrs func)))))))
(cdr (assoc :is-macro (mal-data-attrs func)))))))
(defun mal-macroexpand (ast env)
(loop
@ -146,7 +146,7 @@
(env:set-env env
(second forms)
(progn
(setf (cdr (assoc 'is-macro (mal-data-attrs value))) t)
(setf (cdr (assoc :is-macro (mal-data-attrs value))) t)
value))
(error 'invalid-function
:form value
@ -188,10 +188,10 @@
(mal-eval body (env:create-mal-env :parent env
:binds (listify (mal-data-value arglist))
:exprs args)))
:attrs (list (cons 'params arglist)
(cons 'ast body)
(cons 'env env)
(cons 'is-macro nil))))))
:attrs (list (cons :params arglist)
(cons :ast body)
(cons :env env)
(cons :is-macro nil))))))
((mal-data-value= mal-try* (first forms))
(handler-case
@ -213,11 +213,11 @@
;; If first element is a mal function unwrap it
(cond ((mal-fn-p function)
(let* ((attrs (mal-data-attrs function)))
(setf ast (cdr (assoc 'ast attrs))
env (env:create-mal-env :parent (cdr (assoc 'env attrs))
(setf ast (cdr (assoc :ast attrs))
env (env:create-mal-env :parent (cdr (assoc :env attrs))
:binds (map 'list
#'identity
(mal-data-value (cdr (assoc 'params attrs))))
(mal-data-value (cdr (assoc :params attrs))))
:exprs (cdr evaluated-list)))))
((mal-builtin-fn-p function)
(return (apply (mal-data-value function)

3
es6/core.mjs
View File

@ -44,11 +44,14 @@ export const core_ns = new Map([
['nil?', a => a === null],
['true?', a => a === true],
['false?', a => a === false],
['number?', a => typeof a === 'number'],
['string?', a => typeof a === "string" && !_keyword_Q(a)],
['symbol', a => Symbol.for(a)],
['symbol?', a => typeof a === 'symbol'],
['keyword', _keyword],
['keyword?', _keyword_Q],
['fn?', a => typeof a === 'function' && !a.ismacro ],
['macro?', a => typeof a === 'function' && !!a.ismacro ],
['pr-str', (...a) => a.map(e => pr_str(e,1)).join(' ')],
['str', (...a) => a.map(e => pr_str(e,0)).join('')],

3
guile/core.scm
View File

@ -235,6 +235,7 @@
(nil? ,_nil?)
(true? ,_true?)
(false? ,_false?)
(number? ,number?)
(symbol? ,symbol?)
(symbol ,->symbol)
(string? ,_string?)
@ -251,6 +252,8 @@
(vals ,_vals)
(contains? ,_contains?)
(sequential? ,_sequential?)
(fn? ,is-func?)
(macro? ,is-macro?)
(readline ,__readline)
(meta ,_meta)
(with-meta ,_with-meta)

2
guile/step6_file.scm
View File

@ -37,7 +37,7 @@
(define (eval_func ast env)
(define (_eval o) (EVAL o env))
(define (func? x) (and=> ((env 'get) x) is-func?))
(define (func? x) (and=> ((env 'get) x) is-func))
(cond
((func? (car ast))
=> (lambda (c)

2
guile/step7_quote.scm
View File

@ -37,7 +37,7 @@
(define (eval_func ast env)
(define (_eval o) (EVAL o env))
(define (func? x) (and=> ((env 'get) x) is-func?))
(define (func? x) (and=> ((env 'get) x) is-func))
(cond
((func? (car ast))
=> (lambda (c)

4
guile/step8_macros.scm
View File

@ -37,7 +37,7 @@
(define (eval_func ast env)
(define (_eval o) (EVAL o env))
(define (func? x) (and=> ((env 'get) x) is-func?))
(define (func? x) (and=> ((env 'get) x) is-func))
(cond
((func? (car ast))
=> (lambda (c)
@ -55,7 +55,7 @@
(define (is_macro_call ast env)
(and (list? ast)
(> (length ast) 0)
(and=> (env-check (car ast) env) is-macro?)))
(and=> (env-check (car ast) env) is-macro)))
(define (_macroexpand ast env)
(cond

4
guile/step9_try.scm
View File

@ -37,7 +37,7 @@
(define (eval_func ast env)
(define (_eval o) (EVAL o env))
(define (func? x) (and=> (env-check x env) is-func?))
(define (func? x) (and=> (env-check x env) is-func))
;;(format #t "AAA: ~a~%" (func? (car ast)))
(cond
((func? (car ast))
@ -56,7 +56,7 @@
(define (is_macro_call ast env)
(and (list? ast)
(> (length ast) 0)
(and=> (env-check (car ast) env) is-macro?)))
(and=> (env-check (car ast) env) is-macro)))
(define (_macroexpand ast env)
(cond

4
guile/stepA_mal.scm
View File

@ -52,7 +52,7 @@
x)))
(if (callable? f)
f
(and=> (env-check f env) is-func?))))
(and=> (env-check f env) is-func))))
(cond
((func? (car ast))
=> (lambda (c)
@ -70,7 +70,7 @@
(define (is_macro_call ast env)
(and (list? ast)
(> (length ast) 0)
(and=> (env-check (car ast) env) is-macro?)))
(and=> (env-check (car ast) env) is-macro)))
(define (_macroexpand ast env)
(cond

8
guile/types.scm
View File

@ -21,7 +21,7 @@
make-atom atom? atom-val atom-val-set!
make-callable callable? callable-is_macro
callable-is_macro-set! callable-closure
is-func? is-macro? make-func callable-apply
is-func is-func? is-macro is-macro? make-func callable-apply
callable-unbox-set! callable-unbox
callable-meta-info hash-table-clone
box? box unbox)
@ -77,8 +77,10 @@
(eq? (callable-is_macro c) b)
c))
(define (is-func? c) (callable-check c #f))
(define (is-macro? c) (callable-check c #t))
(define (is-func c) (callable-check c #f))
(define (is-func? c) (and (is-func c) #t))
(define (is-macro c) (callable-check c #t))
(define (is-macro? c) (and (is-macro c) #t))
(define (hash-table-clone ht)
(list->hash-map (hash-fold (lambda (k v p) (cons k (cons v p))) '() ht)))

20
java/src/main/java/mal/core.java
View File

@ -49,6 +49,11 @@ public class core {
return args.nth(0) == False ? True : False;
}
};
static MalFunction number_Q = new MalFunction() {
public MalVal apply(MalList args) throws MalThrowable {
return args.nth(0) instanceof MalInteger ? True : False;
}
};
static MalFunction string_Q = new MalFunction() {
public MalVal apply(MalList args) throws MalThrowable {
if (!(args.nth(0) instanceof MalString)) { return False; }
@ -87,6 +92,18 @@ public class core {
return True;
}
};
static MalFunction fn_Q = new MalFunction() {
public MalVal apply(MalList args) throws MalThrowable {
if (!(args.nth(0) instanceof MalFunction)) { return False; }
return ((MalFunction)args.nth(0)).isMacro() ? False : True;
}
};
static MalFunction macro_Q = new MalFunction() {
public MalVal apply(MalList args) throws MalThrowable {
if (!(args.nth(0) instanceof MalFunction)) { return False; }
return ((MalFunction)args.nth(0)).isMacro() ? True : False;
}
};
// String functions
@ -545,11 +562,14 @@ public class core {
.put("nil?", nil_Q)
.put("true?", true_Q)
.put("false?", false_Q)
.put("number?", number_Q)
.put("string?", string_Q)
.put("symbol", symbol)
.put("symbol?", symbol_Q)
.put("keyword", keyword)
.put("keyword?", keyword_Q)
.put("fn?", fn_Q)
.put("macro?", macro_Q)
.put("pr-str", pr_str)
.put("str", str)

17
mal/core.mal
View File

@ -1,14 +1,31 @@
(def! _fn? (fn* [x]
(if (fn? x)
(if (get (meta x) "ismacro")
false
true)
false)))
(def! macro? (fn* [x]
(if (fn? x)
(if (get (meta x) "ismacro")
true
false)
false)))
(def! core_ns
[["=" =]
["throw" throw]
["nil?" nil?]
["true?" true?]
["false?" false?]
["number?" number?]
["string?" string?]
["symbol" symbol]
["symbol?" symbol?]
["keyword" keyword]
["keyword?" keyword?]
["fn?" _fn?]
["macro?" macro?]
["pr-str" pr-str]
["str" str]