kanaka/mal
1
1
Fork 0
mirror of https://github.com/kanaka/mal.git synced 2024-09-21 02:27:10 +03:00
Code Issues Projects Releases Wiki Activity

Merge pull request #320 from chr15m/php-interop-improvements

Browse Source 
Updated PHP native interop interface.
This commit is contained in:
Joel Martin 2018-06-25 11:04:41 -05:00 committed by GitHub
commit c9ce6b6d55
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
5 changed files with 35 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
php/README.md
View File

@ -32,11 +32,11 @@ Eval PHP code:
Native function call:
(! date "Y-m-d" 0)
1970-01-01
(php/date "Y-m-d" 0)
"1970-01-01"
Accessing PHP "superglobal" variables:
(get ($ "_SERVER") "PHP_SELF")
./mal
(get php/_SERVER "PHP_SELF")
"./mal"

16
php/interop.php
View File

@ -45,4 +45,20 @@ function _to_mal($obj) {
}
}
function _to_native($name, $env) {
if (is_callable($name)) {
return _function(function() use ($name) {
$args = array_map("_to_php", func_get_args());
$res = call_user_func_array($name, $args);
return _to_mal($res);
});
} else if (in_array($name, ["_SERVER", "_GET", "_POST", "_FILES", "_REQUEST", "_SESSION", "_ENV", "_COOKIE"])) {
$val = $GLOBALS[$name];
} else if (defined($name)) {
$val = constant($name);
} else {
$val = ${$name};
}
return _to_mal($val);
}
?>

6
php/reader.php
View File

@ -27,7 +27,7 @@ function _real_token($s) {
}
function tokenize($str) {
$pat = "/[\s,]*(~@|[\[\]{}()'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"|;.*|[^\s\[\]{}('\"`,;)]*)/";
$pat = "/[\s,]*(php\/|~@|[\[\]{}()'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"|;.*|[^\s\[\]{}('\"`,;)]*)/";
preg_match_all($pat, $str, $matches);
return array_values(array_filter($matches[1], '_real_token'));
}
@ -102,6 +102,10 @@ function read_form($reader) {
return _list(_symbol('deref'),
read_form($reader));
case 'php/': $reader->next();
return _list(_symbol('to-native'),
read_form($reader));
case ')': throw new Exception("unexpected ')'");
case '(': return read_list($reader);
case ']': throw new Exception("unexpected ']'");

24
php/stepA_mal.php
View File

@ -72,7 +72,6 @@ function eval_ast($ast, $env) {
}
function MAL_EVAL($ast, $env) {
$_SUPERGLOBALS = ["_SERVER", "_GET", "_POST", "_FILES", "_REQUEST", "_SESSION", "_ENV", "_COOKIE"];
while (true) {
#echo "MAL_EVAL: " . _pr_str($ast) . "\n";
@ -152,27 +151,8 @@ function MAL_EVAL($ast, $env) {
case "fn*":
return _function('MAL_EVAL', 'native',
$ast[2], $env, $ast[1]);
case "$":
$var = MAL_EVAL($ast[1], $env);
if (_symbol_Q($var)) {
$varname = $var->value;
} elseif (gettype($var) === "string") {
$varname = $var;
} else {
throw new Exception("$ arg unknown type: " . gettype($var));
}
if (in_array($varname, $_SUPERGLOBALS)) {
$val = $GLOBALS[$varname];
} else {
$val = ${$varname};
}
return _to_mal($val);
case "!":
$fn = $ast[1]->value;
$el = eval_ast($ast->slice(2), $env);
$args = _to_php($el);
$res = call_user_func_array($fn, $args);
return _to_mal($res);
case "to-native":
return _to_native($ast[1]->value, $env);
default:
$el = eval_ast($ast, $env);
$f = $el[0];

11
php/tests/stepA_mal.mal
View File

@ -26,15 +26,20 @@
;; testing native function calling
(! date "Y-m-d" 0)
(php/date "Y-m-d" 0)
;=>"1970-01-01"
;; testing native function with mal callback
(! array_map (fn* [t] (if (> t 3) t)) [1 2 3 4 5 6])
(php/array_map (fn* [t] (if (> t 3) t)) [1 2 3 4 5 6])
;=>(nil nil nil 4 5 6)
;; testing superglobal variable access
(get ($ "_SERVER") "PHP_SELF")
(get php/_SERVER "PHP_SELF")
;=>"../php/stepA_mal.php"
;; testing PHP constants access
php/FILE_APPEND
;=>8