├── .github
    └── ISSUE_TEMPLATE
    │   └── bug_report.md
├── .gitignore
├── LICENSE
├── bin
    ├── pharen
    └── pharen.bat
├── composer.json
├── debug.php
├── examples
    ├── array_benches.php
    ├── css.phn
    ├── four_row.phn
    ├── reduce_benchmarks.phn
    └── vm.phn
├── extras
    ├── .ctags
    └── .vimrc
├── install.bat
├── install.sh
├── lang.phn
├── lang.php
├── lexical.php
├── lib
    ├── phake
    │   ├── builtins.phn
    │   ├── phake.phn
    │   ├── phakefile
    │   └── templates
    │   │   └── default
    │   │       ├── main.phn
    │   │       ├── phakefile
    │   │       └── test
    │   │           └── tests.phn
    ├── pharen
    │   ├── bench.phn
    │   ├── html.phn
    │   ├── lazy.phn
    │   ├── path.phn
    │   ├── repl.phn
    │   ├── sql.phn
    │   ├── stats.phn
    │   └── test.phn
    └── sequence.php
├── phakefile
├── pharen.php
├── readme.markdown
├── template_debug.php
├── test
    ├── pharen_tests.phn
    └── tests
    │   ├── bindings.phn
    │   ├── comments.phn
    │   ├── cond.phn
    │   ├── func_calls.phn
    │   ├── function_definition.phn
    │   ├── if.phn
    │   ├── lambdas.phn
    │   ├── lang_functions.phn
    │   ├── lazy.phn
    │   ├── lists_and_dicts.phn
    │   ├── literals.phn
    │   ├── macros.phn
    │   ├── multi.phn
    │   ├── ns.phn
    │   ├── oop.phn
    │   ├── php_interop.phn
    │   ├── plambda.phn
    │   └── types.phn
└── todo.txt


/.github/ISSUE_TEMPLATE/bug_report.md:
--------------------------------------------------------------------------------
1 | ---
2 | name: Bug report
3 | about: Create a report to help us improve
4 | 
5 | ---
6 | 
7 | Bug type 2
8 | 


--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
 1 | pharen_old.php
 2 | phakefile.php
 3 | lib/phake/phake.php
 4 | lib/phake/builtins.php
 5 | *.tmp
 6 | *.swp
 7 | lib/pharen/*.php
 8 | examples/*.php
 9 | test/*.php
10 | test/tmp
11 | ex
12 | .DS_Store
13 | 


--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
1 | Copyright (c) 2010, Tamreen Khan
2 | All rights reserved.
3 | 
4 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
5 | 
6 | Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
7 | Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
8 | Neither the name of the <ORGANIZATION> nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.
9 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.


--------------------------------------------------------------------------------
/bin/pharen:
--------------------------------------------------------------------------------
 1 | #! /usr/bin/env php
 2 | <?php
 3 | $dir = dirname(__FILE__);
 4 | $pharen_dir = substr($dir, 0, strrpos($dir, DIRECTORY_SEPARATOR));
 5 | include($pharen_dir.DIRECTORY_SEPARATOR."pharen.php");
 6 | 
 7 | if(__FILE__ === realpath($_SERVER['SCRIPT_NAME'])){
 8 |     $input_files = array();
 9 |     if(isset($argv) && isset($argv[1])){
10 |         array_shift($argv);
11 |         foreach($argv as $arg){
12 |             if(strpos($arg, "--") === 0){
13 |                 set_flag(substr($arg, 2));
14 |             }else if(strpos($arg, "-") === 0){
15 |                 $simple_args = substr($arg, 1);
16 |                 foreach(str_split($simple_args) as $simple_arg){
17 |                     set_flag($simple_arg);
18 |                 }
19 |             }else{
20 |                 $input_files[] = $arg;
21 |             }
22 |         }
23 |     }
24 | 
25 |     compile_lang();
26 | 
27 |     $php_code = "";
28 |     if(isset($_SERVER['REQUEST_METHOD'])){
29 |         $php_code = $lang_code;
30 |     }else{
31 |         $php_code = "";
32 |     }
33 | 
34 |     if(count($input_files) === 0 || isset(Flags::$flags['repl'])){
35 |         compile_file(stream_resolve_include_path("path.phn"));
36 |         compile_file(stream_resolve_include_path("repl.phn"));
37 |     }
38 |     foreach($input_files as $file){
39 |         $php_code .= compile_file($file);
40 |     }
41 |     $num_input_files = count($input_files);
42 |     if($num_input_files === 0 || isset(Flags::$flags['repl'])){
43 |         $repl_vars = array();
44 |         include_once("repl.php");
45 |         if($num_input_files > 0){
46 |             define("PHARENREPLMODE", True);
47 |             $last_file_php = str_replace(".phn", ".php", $input_files[$num_input_files-1]);
48 |             $repl_vars = pharen\repl\get_file_vars($last_file_php, get_defined_vars());
49 |         }
50 |         NamespaceNode::$repling = True;
51 |         echo pharen\repl\intro();
52 |         compile_lang();
53 |         set_include_path(get_include_path() . PATH_SEPARATOR . getcwd());
54 |         pharen\repl\work("", $repl_vars);
55 |     }
56 |     if(isset($_SERVER['REQUEST_METHOD'])){
57 |         echo "<pre>$php_code</pre>";
58 |     }
59 | }
60 | 


--------------------------------------------------------------------------------
/bin/pharen.bat:
--------------------------------------------------------------------------------
1 | @echo off
2 | SET pharen_bin_dir=%~dp0
3 | php %pharen_bin_dir%\pharen %*
4 | 


--------------------------------------------------------------------------------
/composer.json:
--------------------------------------------------------------------------------
 1 | {
 2 |   "name": "pharen/pharen",
 3 |   "description": "Pharen is a compiler that takes a Lisp-like language and turns it into PHP code.",
 4 |   "keywords": ["Lisp","Clojure"],
 5 |   "homepage": "http://scriptor.github.com/pharen/",
 6 |   "type": "library",
 7 |   "license": "",
 8 |   "authors": [
 9 |     {
10 |       "name": "Tamreen Khan",
11 |       "email": "tamreenkhan@gmail.com"
12 |     }
13 |   ],
14 |   "bin": ["bin/pharen"],
15 |   "require": {
16 |     "php": ">=5.3.0"
17 |   }
18 | }
19 |   
20 | 


--------------------------------------------------------------------------------
/debug.php:
--------------------------------------------------------------------------------
1 | <?php
2 | namespace pharen;
3 | class Debug{
4 |     public static $line_mapping;
5 | }
6 | 


--------------------------------------------------------------------------------
/examples/array_benches.php:
--------------------------------------------------------------------------------
 1 | <?php
 2 | function test_foreach(array $arr){
 3 |     $sum = 0;
 4 |     foreach($arr as $x){
 5 |         $sum += $x;
 6 |     }
 7 |     return $sum;
 8 | }
 9 | 
10 | function test_array_reduce(array $arr){
11 |     return array_reduce($arr, "add", 0);
12 | }
13 | 


--------------------------------------------------------------------------------
/examples/css.phn:
--------------------------------------------------------------------------------
 1 | (ns awe)
 2 | 
 3 | (fn get-rules (css)
 4 |   (let [pairs (partition 2 (rest css))]
 5 |     (cons (first css)
 6 |           (reduce (lambda (pair rules)
 7 |                           (if (seq? (:pair 0))
 8 |                             (concat rules (map #get-rules pair))
 9 |                             (append {(:pair 0) (:pair 1)} rules)))
10 |                   []
11 |                   pairs))))
12 | 
13 | (fn process-rules (rules [parent-sel ""])
14 |   (let [selector (trim (. parent-sel " " (first rules)))]
15 |     (fn process-rule (rule)
16 |       (if (assoc? rule)
17 |         (let [rule (seq rule)]
18 |           (. (:rule 0 0) ": " (:rule 0 1) ";"))
19 |         (process-rules rule selector)))
20 | 
21 |     (cons selector (map #process-rule (rest rules)))))
22 | 
23 | (fn gen-css (rule-strs [start-indent ""])
24 |   (let [indent (. start-indent "    ")
25 |         selector (first rule-strs)
26 |         state (reduce (lambda (rule-str state)
27 |                               (if (seq? rule-str)
28 |                                 [(:state 0) (append (gen-css rule-str indent) (:state 1))]
29 |                                 [(. (:state 0) (. indent rule-str "\n")) (:state 1)]))
30 |                       ["" []]
31 |                       (rest rule-strs))]
32 |     (. start-indent selector " {\n" (:state 0) start-indent "}\n" (seq-join (:state 1) "\n"))))
33 | 
34 | (fn css (&css-seqs)
35 |   (seq-join
36 |     (map (lambda (css-seq)
37 |                  (gen-css (process-rules (get-rules css-seq))))
38 |          css-seqs)))
39 | 
40 | (def content-css
41 |   [:div#content
42 |    :width: "80%"
43 |    :margin-left "5px"
44 |    :margin-right "5px"
45 |    [:a
46 |     :color "#00F"
47 |     [:img
48 |      :width "200px"]]
49 |    [:p
50 |     :font "Helvetica"]])
51 | 
52 | (def sidebar-css
53 |   [:div#sidebar
54 |    :width "20%"])
55 | 
56 | (prn (css content-css sidebar-css))
57 | 


--------------------------------------------------------------------------------
/examples/four_row.phn:
--------------------------------------------------------------------------------
 1 | (ns four-row)
 2 | (use pharen-repl as repl)
 3 | (require-once "repl.php")
 4 | (use lazy)
 5 | 
 6 | ; Defined bottom-up: Row of index 0 is the bottom row
 7 | (def board
 8 |   [[0 0 0]
 9 |    [0 0 0]
10 |    [0 0 0]])
11 | 
12 | (fn board ([x 7] [y 6])
13 |   (array-fill 0 y
14 |               (array-fill 0 x 0)))
15 | 
16 | (fn prn-board (brd)
17 |   (if (empty? brd)
18 |     (prn "")
19 |     (do
20 |       (prn-board (rest brd))
21 |       (map (lambda (x)
22 |                    (if (not x)
23 |                      (print ". ")
24 |                      (print* x " ")))
25 |            (first brd))
26 |       (prn ""))))
27 | 
28 | (fn place-in-row (row col coin)
29 |   (concat (take col row)
30 |           (cons coin (drop (inc col) row))))
31 | 
32 | (fn drop-coin (coin col brd)
33 |   (if (empty? brd)
34 |     []
35 |     (let [row (first brd)
36 |           rst (rest brd)]
37 |       (if (:row col)
38 |         (cons row (drop-coin coin col rst))
39 |         (cons (place-in-row row col coin) rst)))))
40 | 
41 | (fn apply-delta (pos board delta)
42 |   (let [height (count board)
43 |         width (count (:board 0))
44 |         new-pos [(+ (:pos 0) (:delta 0)) (+ (:pos 1) (:delta 1))]
45 |         x (:new-pos 0)
46 |         y (:new-pos 1)]
47 |     (if (or (neg? x) (neg? y) (>= height y) (>= width x))
48 |       FALSE
49 |       new-pos)))
50 | 
51 | 
52 | (fn neighbors (pos board)
53 |   (let [deltas [[-1 0] [-1 -1] [0 -1] [1 -1] [1 0]]]
54 |     (filter #identity (map (apply-delta pos board) deltas))))
55 | 
56 | (fn prompt-move (player)
57 |   (intval (repl.prompt (. "Player " player "> "))))
58 | 
59 | (fn player1 (col brd)
60 |   (let [b (drop-coin 1 col brd)]
61 |     (prn-board b)
62 |     b))
63 | 
64 | (fn player2 (col brd)
65 |   (let [b (drop-coin 2 col brd)]
66 |     (prn-board b)
67 |     b))
68 | 
69 | (if (not (repling))
70 |   (let [players (cycle [#four-row.player1 #four-row.player2])
71 |         num-moves (repl.prompt "How many moves? ")
72 |         p1moves (repeatedly (thunk (prompt-move "1")))
73 |         p2moves (repeatedly (thunk (prompt-move "2")))
74 |         moves (lazy.interleave p1moves p2moves)]
75 |     (prn-board (reduce-fns players (board) (lazy.take num-moves moves)))))
76 | 


--------------------------------------------------------------------------------
/examples/reduce_benchmarks.phn:
--------------------------------------------------------------------------------
 1 | (load "pharen/bench")
 2 | (require "examples/array_benches.php")
 3 | 
 4 | (fun add (x y)
 5 |      (+ x y))
 6 | (poly-ann reduce (^#add f acc ^FastSeq xs))
 7 | 
 8 | (def xs [1 .. 1000])
 9 | (ann xs ^FastSeq)
10 | (def arr (range 1 1000))
11 | 
12 | (def reduce-bench (bench "reduce" (reduce #add 0 xs)))
13 | (def array-bench (bench "array_reduce" (test-array-reduce arr)))
14 | (def foreach-bench (bench "foreach" (test-foreach arr)))
15 | 
16 | (compare-benches reduce-bench array-bench)
17 | (compare-benches reduce-bench foreach-bench)
18 | 


--------------------------------------------------------------------------------
/examples/vm.phn:
--------------------------------------------------------------------------------
 1 | (defmacro when-set (val)
 2 |   '(when (isset ~val) ~val))
 3 | 
 4 | (defmacro defop (name args &key-val-pairs)
 5 |   (def args-len (count args))
 6 |   (def state (reduce (lambda (pair state)
 7 |                              (assoc (:pair 0) (:pair 1) state))
 8 |                      {:pc (:args (- args-len 4))
 9 |                       :stack (:args (- args-len 3))
10 |                       :flags (:args (- args-len 2))
11 |                       :instructions (:args (- args-len 1))}
12 |                      (partition 2 key-val-pairs)))
13 |   '(fn ~name ~args ~state))
14 | 
15 | (defop jmp (loc pc stack flags instrs)
16 |   :pc loc)
17 | 
18 | (defop cmp (loc pc stack flags instrs)
19 |   (let [flags (& (zero? (- (:stack a) (:stack b))) flags)]
20 |     :flags flags))
21 | 
22 | (defop jeq (loc cur-pc stack flags instrs)
23 |   :pc (if (& flags 1)
24 |         loc
25 |         cur-pc))
26 | 
27 | (defop psh (val pc stack flags instrs)
28 |   :stack (cons val stack))
29 | 
30 | (fn stepper (_ state)
31 |   (let [pc (:state :pc)
32 |         stack (:state :stack)
33 |         flags (:state :flags)
34 |         instrs (:state :instructions)
35 |         instr (:instrs pc)
36 |         op (:instr 0)
37 |         a (:instr 1)
38 |         b (when-set (:instr 2))
39 |         c (when-set (:instr 3))]
40 |     ((cond
41 |        ((=== op :jmp) (jmp a))
42 |        ((=== op :cmp) (cmp a b))
43 |        ((=== op :jeq) (jeq a pc))
44 |        ((=== op :psh) (psh a)))
45 |        (inc pc) stack flags instrs)))
46 | 
47 | (fn run (instrs)
48 |   (reduce #stepper 
49 |           {:pc 0
50 |            :stack []
51 |            :flags 0
52 |            :instructions [[:jmp 1] [:jmp 0]]}
53 |           (infinity)))
54 | 
55 | (run [[:jmp 1] [:jmp 0]])
56 | 


--------------------------------------------------------------------------------
/extras/.ctags:
--------------------------------------------------------------------------------
1 | --langdef=Pharen
2 | --langmap=Pharen:.phn
3 | --regex-pharen=/\([ \t]*def[ \t]+([-[:alnum:]*+!_:\/.?]+)/\1/d,definition/
4 | --regex-pharen=/\([ \t]*fn[ \t]+([-[:alnum:]*+!_:\/.?]+)/\1/f,function/
5 | --regex-pharen=/\([ \t]*defmacro[ \t]+([-[:alnum:]*+!_:\/.?]+)/\1/m,macro/
6 | --regex-pharen=/\([ \t]*defmulti[ \t]+([-[:alnum:]*+!_:\/.?]+)/\1/a,multimethod definition/
7 | --regex-pharen=/\([ \t]*defmethod[ \t]+([-[:alnum:]*+!_:\/.?]+)/\1/b,multimethod instance/
8 | --regex-pharen=/\([ \t]*ns[ \t]+([-[:alnum:]*+!_:\/.?]+)/\1/n,namespace/
9 | 


--------------------------------------------------------------------------------
/extras/.vimrc:
--------------------------------------------------------------------------------
1 | " Assumes clojure syntax highlighting already exists
2 | au BufNewFile,BufRead *.phn set filetype=clojure
3 | au BufNewFile,BufRead phakefile set filetype=clojure
4 | 


--------------------------------------------------------------------------------
/install.bat:
--------------------------------------------------------------------------------
1 | @echo OFF
2 | SET pharen_bin_dir=%~dp0
3 | setx PATH "%pharen_bin_dir%bin;%path%;"
4 | echo "Pharen successfully installed."
5 | 


--------------------------------------------------------------------------------
/install.sh:
--------------------------------------------------------------------------------
 1 | #!/bin/bash
 2 | pushd `dirname $0` > /dev/null
 3 | pharen_dir=`pwd`
 4 | popd > /dev/null
 5 | echo $pharen_dir
 6 | if [ ! -e "/usr/local/bin/pharen" ]
 7 | then
 8 |     ln -s $pharen_dir/bin/pharen /usr/local/bin/pharen
 9 |     echo "Pharen successfully installed."
10 | else
11 |     echo "There is already a file called 'pharen' in /usr/local/bin. Maybe it's already installed?"
12 | fi
13 | 


--------------------------------------------------------------------------------
/lang.phn:
--------------------------------------------------------------------------------
  1 | (define "SYSTEM" (dirname __FILE__))
  2 | (define "LIB_PATH" (. SYSTEM "/lib/"))
  3 | (define "LIB_PHAREN_PATH" (. SYSTEM "/lib/pharen/"))
  4 | (set-include-path (. (get-include-path) PATH_SEPARATOR LIB_PATH PATH_SEPARATOR LIB_PHAREN_PATH))
  5 | (require "sequence.php")
  6 | 
  7 | (defmacro comment (&exprs)
  8 |   'NULL)
  9 | 
 10 | (defmacro when (c &body)
 11 |   '(if ~c
 12 |      (do
 13 |        ~@body)
 14 |      NULL))
 15 | 
 16 | (defmacro when-set (val)
 17 |   '(when (isset ~val) ~val))
 18 | 
 19 | (defmacro error (&msgs)
 20 |   '(error-log (. ~@msgs)))
 21 | 
 22 | (defmacro not (expr)
 23 |   '(! ~expr))
 24 | 
 25 | (defmacro not-set (expr)
 26 |   '(not (isset ~expr)))
 27 | 
 28 | (defmacro pharen-or (e1 e2)
 29 |   '(if ~e1 ~e1 ~e2)) 
 30 | 
 31 | (defmacro pharen-and (e1 e2)
 32 |   '(cond
 33 |      ((not ~e1) ~e1)
 34 |      ((not ~e2) ~e2)
 35 |      (TRUE      ~e2)))
 36 | 
 37 | (defmacro load (name)
 38 |   (def php-file (. name ".php"))
 39 |   (local file (. name ".phn"))
 40 |   (local old-node-ns (:: Node ns))
 41 |   (local old-ns (:: RootNode ns))
 42 |   (local raw-ns (:: RootNode raw-ns))
 43 |   (local old-ns_string (:: RootNode ns-string))
 44 |   (local lib-path (stream-resolve-include-path file))
 45 |   (when lib-path
 46 |     (compile-file lib-path)
 47 |     (= (:: Node ns) old-node-ns)
 48 |     (= (:: RootNode ns) old-ns)
 49 |     (= (:: RootNode ns-string) old-ns-string)
 50 |     (= (:: RootNode raw-ns) raw-ns)
 51 |     '(include ~php-file)))
 52 | 
 53 | 
 54 | (defmacro runtime (expr)
 55 |   '(let [time-start (microtime TRUE)
 56 |          result ~expr
 57 |          time-duration (- (microtime TRUE) time-start)
 58 |          time-to-display (if (> time-duration 1)
 59 |                            (. time-duration " seconds")
 60 |                            (. (* time-duration 1000)  " milliseconds"))]
 61 |      (print (. "Elapsed time: " time-to-display "\n"))
 62 |      NULL))
 63 | 
 64 | (defmacro thunk (&exprs)
 65 |   '(lambda () ~@exprs))
 66 | 
 67 | (defmacro inst? (var cls)
 68 |   '(instanceof ~var ~-cls))
 69 | 
 70 | (defmacro print* (&s)
 71 |   '(print (. ~@s)))
 72 | 
 73 | (fn first (xs)
 74 |   (-> (seq xs) (first)))
 75 | (poly-ann first (^Seq xs))
 76 | (fun first (^FastSeq xs)
 77 |      (-> xs first))
 78 | 
 79 | (fn rest (xs)
 80 |   (-> (seq xs) (rest)))
 81 | (poly-ann rest (^Seq xs))
 82 | (fun rest (^FastSeq xs)
 83 |      (-> xs rest))
 84 | 
 85 | (fn pharen-list (a &xs)
 86 |   (cons a xs))
 87 | 
 88 | (fn butlast (xs)
 89 |   (take (dec (count xs)) xs))
 90 | 
 91 | (fn last (xs)
 92 |   (:xs (dec (count xs))))
 93 | 
 94 | (fn eq (val1 val2)
 95 |   (cond 
 96 |     ((inst? val1 IPharenComparable) (-> val1 (eq val2)))
 97 |     ((inst? val2 IPharenComparable) (-> val2 (eq val1)))
 98 |     (TRUE (=== val1 val2))))
 99 | 
100 | (defmacro if-let (binding then else)
101 |   (def cond (:binding 1))
102 |   '(if ~cond
103 |      (let ~binding
104 |        ~then)
105 |      ~else))
106 | 
107 | (defmacro when-let (binding then)
108 |   (def cond (:binding 1))
109 |   '(when ~cond
110 |      (let ~binding
111 |        ~then)))
112 | 
113 | (defmacro if-not (cond then else)
114 |   '(if (not ~cond)
115 |      ~then
116 |      ~else))
117 | 
118 | (defmacro when-not (cond &then)
119 |   '(when (not ~cond)
120 |      ~@then))
121 | 
122 | (defmacro dotimes (binding &exprs)
123 |   (def varname (:binding 0))
124 |   (def n (:binding 1))
125 |   '((lambda (~varname --dotimes-result)
126 |            (if (>= ~varname ~n)
127 |              --dotimes-result
128 |              (do
129 |                (local --dotimes-result (do ~@exprs))
130 |                (recur (inc ~varname) --dotimes-result)))) 0 NULL))
131 | 
132 | (fn prn (s &other)
133 |   (let
134 |     [str (. s (seq-join other))]
135 |     (print* str "\n")
136 |     NULL))
137 | 
138 | (fn false? (x)
139 |   (=== FALSE x))
140 | 
141 | (fn true? (x)
142 |   (=== TRUE x))
143 | 
144 | (fn null? (x)
145 |   (=== NULL x))
146 | 
147 | (fn zero? (n)
148 |   (=== n 0))
149 | 
150 | (fn pos? (n)
151 |   (> n 0))
152 | 
153 | (fn neg? (n)
154 |   (< n 0))
155 | 
156 | (fn odd? (n)
157 |   (=== (% n 2) 1))
158 | 
159 | (fn even? (n)
160 |   (=== (% n 2) 0))
161 | 
162 | (fn str (s1 s2)
163 |   (. s1 s2))
164 | 
165 | (fn identity (x)
166 |   x)
167 | 
168 | (fn inc (x)
169 |   (+ 1 x))
170 | 
171 | (fn dec (x)
172 |   (- x 1))
173 | 
174 | (defmacro set! (var val)
175 |   '(local ~var ~val))
176 | 
177 | (defmacro alter (var f &args)
178 |   '(local ~var (~$f ~var ~@args)))
179 | 
180 | (fn comp (&fs)
181 |   (let [rfs (reverse fs)]
182 |     (lambda (&args)
183 |             (let [init (call-user-func-array (first rfs) (arr args))]
184 |               (reduce #apply init (rest rfs))))))
185 | 
186 | (fn zero-or-empty? (n xs)
187 |   (or (zero? n) (empty? xs)))
188 | 
189 | (fn empty? (xs)
190 |   (or (inst? (seq xs) .PharenEmptyList) (not (seq xs))))
191 | (poly-ann empty? (^Seq xs))
192 | (fun empty? (^FastSeq xs)
193 |      (=== (-> xs length) 0))
194 | 
195 | (fn seq? (x)
196 |   (inst? x IPharenSeq))
197 | (fun seq? (^Seq x)
198 |      TRUE)
199 | 
200 | (fn sequential? (x)
201 |   (or (inst? x IPharenSeq) (is-array x)))
202 | 
203 | (fn assoc? (x)
204 |   (inst? x PharenHashMap))
205 | 
206 | (fn seq (x)
207 |   (if (inst? x IPharenSeq)
208 |     (-> x (seq))
209 |     (:: PharenList (seqify x))))
210 | (fun seq (^Seq x)
211 |      x)
212 | (fun seq (^FastSeq x)
213 |      x)
214 | 
215 | (fn hashify (x)
216 |   (if (inst? x PharenHashMap)
217 |     x
218 |     (new PharenHashMap x))) ; TODO: Do actual conversion into a hashmap-suitable data structure
219 | 
220 | (fn hash-from-pairs (pairs)
221 |   (reduce (lambda (pair hm)
222 |                   (assoc (:pair 0) (:pair 1) hm))
223 |           {}
224 |           pairs))
225 | 
226 | (fn force (x)
227 |   (-> x (force)))
228 | 
229 | (fn realized? (x)
230 |   (-> x (realized)))
231 | 
232 | (defmacro lazy-obj (cls &exprs)
233 |   '(new ~cls (lambda () ~@exprs)))
234 | 
235 | (defmacro delay (expr)
236 |   '(lazy-obj .PharenDelay ~expr))
237 | 
238 | (defmacro lazy-seq (list-expr)
239 |   '(lazy-obj .PharenLazyList ~list-expr))
240 | 
241 | (fn arr (x)
242 |   (cond
243 |     ((is-array x) x)
244 |     ((inst? x "PharenHashMap") (-> x (arr)))
245 |     ((inst? x "IPharenSeq") (-> x (arr)))))
246 | 
247 | 
248 | (defmacro second (xs)
249 |   '(first (rest ~xs)))
250 | 
251 | (fn first-pair (xs)
252 |   (array-slice xs 0 1))
253 | 
254 | (fn cons (x xs)
255 |   (if (seq? xs)
256 |     (-> xs (cons x))
257 |     (-> (seq xs) (cons x))))
258 | (poly-ann cons (x ^Seq xs))
259 | 
260 | (fn assoc (key val hm)
261 |   (-> (hashify hm) (assoc key val)))
262 | 
263 | (fn get (key hm)
264 |   (if (isset (:hm key))
265 |     (:hm key)
266 |     NULL))
267 | 
268 | (fn take (n xs)
269 |   (if (zero-or-empty? n xs)
270 |     []
271 |     (cons (first xs) (take (- n 1) (rest xs)))))
272 | 
273 | (fn drop (n xs)
274 |   (if (zero-or-empty? n xs)
275 |     xs
276 |     (drop (- n 1) (rest xs))))
277 | 
278 | (fn reverse (xs [acc []])
279 |   (if (empty? xs)
280 |     acc
281 |     (reverse (rest xs) (cons (first xs) acc))))
282 | 
283 | (fn interpose (sep xs [acc []])
284 |   (if (=== (count xs) 1)
285 |     [(first xs)]
286 |     (cons (first xs) (cons sep (interpose sep (rest xs))))))
287 | 
288 | (fn partition (n xs)
289 |   (if (empty? xs)
290 |     xs
291 |     (cons (take n xs) (partition n (drop n xs)))))
292 | 
293 | (fn interleave (xs ys)
294 |   (if (or (empty? xs) (empty? ys))
295 |     []
296 |     (cons (first xs) (cons (first ys) (interleave (rest xs) (rest ys))))))
297 | 
298 | (fn zip-with (f xs ys)
299 |   (if (or (empty? xs) (empty? ys))
300 |     []
301 |     (cons ($f (first xs) (first ys))
302 |           (zip-with f (rest xs) (rest ys)))))
303 | 
304 | (fn pharen-sort (xs)
305 |   (let [arr (arr xs)]
306 |     (sort arr)
307 |     arr))
308 | 
309 | (fn seq-join (xs [glue ""])
310 |   (implode glue (arr xs)))
311 | 
312 | (fn seq-rand (xs)
313 |   (:xs (rand 0 (dec (count xs)))))
314 | 
315 | (fn infinity ([n 0])
316 |   (lazy-seq (cons n (infinity (+ n 1)))))
317 | 
318 | (fn repeat (x)
319 |   (lazy-seq (cons x (repeat x))))
320 | 
321 | (fn repeatedly (f)
322 |   (lazy-seq (cons ($f) (repeatedly f))))
323 | 
324 | (fn iterate (f init)
325 |   (lazy-seq (cons init (iterate f ($f init)))))
326 | 
327 | (fn cycle (xs)
328 |   (lazy-seq (concat xs (cycle xs))))
329 | 
330 | (fn cycle-with (f xs)
331 |   (lazy-seq
332 |     (let [new-xs (map f xs)]
333 |       (concat xs (cycle-with f new-xs)))))
334 | 
335 | (fn vals (m)
336 |   (array-values (arr m)))
337 | 
338 | (fn append (x xs)
339 |   (concat xs [x]))
340 | 
341 | (fn apply (f &args)
342 |   (let [name (if (is-array f) (:f 0) f)
343 |         args-array (arr (if (sequential? (last args))
344 |                           (concat (butlast args) (last args))
345 |                           args))]
346 |     (when (is-array f)
347 |       (array-push args-array (:f 1)))
348 |     (call-user-func-array name args-array)))
349 | 
350 | (fn flip (f)
351 |   (lambda (x y)
352 |           ($f y x)))
353 | 
354 | (fn juxt (&fs)
355 |     (lambda (&args)
356 |             (map (lambda (f) (apply f args))
357 |                  fs)))
358 | 
359 | (fn concat (xs1 xs2)
360 |   (if (empty? xs1)
361 |     xs2
362 |     (cons (first xs1) (concat (rest xs1) xs2))))
363 | 
364 | (fn into (to from)
365 |   (reduce #cons to from))
366 | 
367 | (fn reduce (f acc xs)
368 |   (if (empty? xs)
369 |     acc
370 |     (reduce f ($f (first xs) acc) (rest xs))))
371 | (poly-ann reduce (f acc ^Seq xs))
372 | (poly-ann reduce (f acc ^FastSeq xs))
373 | 
374 | (fn reduce-fns (fns acc xs)
375 |   (if (empty? xs)
376 |     acc
377 |     (reduce-fns (rest fns) ((first fns) (first xs) acc) (rest xs))))
378 | 
379 | (fn reduce-to-str (new-val-func xs)
380 |   (reduce (lambda (val acc)
381 |                   (. acc ($new-val-func val)))
382 |           "" xs))
383 | 
384 | (fn reduce-pairs (f acc xs)
385 |   (if (empty? xs)
386 |     acc
387 |     (reduce-pairs f ($f (each xs) acc) (rest xs))))
388 | 
389 | (fn map (f xs)
390 |   (if (empty? xs)
391 |     xs
392 |     (cons ($f (first xs)) (map f (rest xs)))))
393 | 
394 | (fn filter (f coll)
395 |   (if (empty? coll)
396 |     []
397 |     (let [x (first coll), xs (rest coll)]
398 |       (if (not ($f x))
399 |         (filter f xs)
400 |         (cons x (filter f xs))))))
401 | 
402 | (fn until (f xs)
403 |   (cond 
404 |     ((empty? xs) FALSE)
405 |     ((local result ($f (first xs))) result)
406 |     (TRUE (until f (rest xs)))))
407 | 
408 | (fn map-indexed (f xs [idx 0])
409 |   (if (empty? xs)
410 |     []
411 |     (cons ($f (first xs) idx) (map-indexed f (rest xs) (inc idx)))))
412 | 
413 | (fn map-pairs (f pairs)
414 |   (reduce-pairs (lambda (pair acc) (append ($f (:pair 0) (:pair 1)) acc))
415 |                 []
416 |                 pairs))
417 | 
418 | (fn repling ()
419 |   (and (defined "PHARENREPLMODE") (constant "PHARENREPLMODE")))
420 | 
421 | (defmacro attr* (access-modifier name val)
422 |   '(access ~access-modifier (local ~name ~val)))
423 | 
424 | (defmacro attr (name val)
425 |   '(attr* public ~name ~val))
426 | 
427 | (defmacro private-attr (name val)
428 |   '(attr* private ~name ~val))
429 | 
430 | (defmacro static-attr (name val)
431 |   '(attr* static ~name ~val))
432 | 
433 | (defmacro method* (access-modifier name args &code)
434 |   '(access ~access-modifier
435 |            (fn ~name ~args
436 |              ~@code)))
437 | 
438 | (defmacro method (name args &code)
439 |   '(method* public ~name ~args
440 |             ~@code))
441 | 
442 | (defmacro private-method (name args &code)
443 |   '(method* private ~name ~args
444 |             ~@code))
445 | 
446 | (defmacro static-method (name args &code)
447 |   '(method* static ~name ~args
448 |             ~@code))
449 | 
450 | (defmacro this (&exprs)
451 |   '(-> this ~@exprs))
452 | 
453 | (defmacro self (&expr)
454 |   '(:: self ~@exprs))
455 | 
456 | (defmacro signature (name args)
457 |   '(signature* public ~name ~args))
458 | 
459 | (defmacro private-signature (name args)
460 |   '(signature* private ~name ~args))
461 | 
462 | (class MultiManager
463 |        (access static (local multis NULL))
464 | 
465 |        (access static (fn matching-multi-exists (multi-name serialized-args)
466 |                         (isset (:: self (:multis multi-name serialized-args)))))
467 | 
468 |        (access static (fn get-matching-multi (multi-name serialized-args)
469 |                         (:: self (:multis multi-name serialized-args))))
470 | 
471 |        (access static (fn set-multi (multi-name pattern f)
472 |                         (= (:: self (:multis multi-name pattern)) f))))
473 | 
474 | (= (:: MultiManager multis) {})
475 | 
476 | 
477 | 
478 | (fn multi-serialize-args (vals)
479 |   (reduce-to-str (lambda (val)
480 |                          (cond
481 |                            ((is-string val) "str")
482 |                            ((is-int val) "int")
483 |                            ((is-float val) "float")
484 |                            ((is-bool val) "bool")
485 |                            ((is-array val) (if (isset (:val "_multitype")) (:val "_multitype") "5"))
486 |                            ((is-object val) (get-class val))))
487 |                  vals))
488 | 
489 | (fn multi-serialize-pattern (pattern)
490 |   (implode (arr pattern)))
491 | 
492 | (fn get-multi (name args)
493 |   (let [serialized-args (multi-serialize-args args)]
494 |     (if (:: MultiManager (matching-multi-exists name serialized-args))
495 |       (:: MultiManager (get-matching-multi name serialized-args))
496 |       "No matching pattern")))
497 | 
498 | (defmacro defmulti (nm args)
499 |   (def name (. nm ""))
500 |   '(do
501 |      (= (:: MultiManager (:multis ~name)) {})
502 |      (fn ~nm ~args
503 |        ((get-multi ~name (func-get-args)) ~@args))))
504 | 
505 | (defmacro defmethod (nm pattern args &body)
506 |   (def name (. nm ""))
507 |   '(:: MultiManager (set-multi ~name (multi-serialize-pattern ~pattern) (lambda (a) ~@body))))
508 | 


--------------------------------------------------------------------------------
/lang.php:
--------------------------------------------------------------------------------
  1 | <?php
  2 | require_once(dirname(__FILE__).'/lexical.php');
  3 | use Pharen\Lexical as Lexical;
  4 | use \Seq as Seq;
  5 | use \FastSeq as FastSeq;
  6 | Lexical::$scopes['_home_scriptor_pharenlang'] = array();
  7 | define("SYSTEM", dirname(__FILE__));
  8 | define("LIB_PATH", (SYSTEM . "/lib/"));
  9 | define("LIB_PHAREN_PATH", (SYSTEM . "/lib/pharen/"));
 10 | set_include_path((get_include_path() . PATH_SEPARATOR . LIB_PATH . PATH_SEPARATOR . LIB_PHAREN_PATH));
 11 | require("sequence.php");
 12 | function first($xs){
 13 | 	return seq($xs)->first();
 14 | }
 15 | 
 16 | function first1(Seq $xs){
 17 | 	return seq($xs)->first();
 18 | }
 19 | 
 20 | function first2(FastSeq $xs){
 21 | 	return $xs->first;
 22 | }
 23 | 
 24 | function rest($xs){
 25 | 	return seq($xs)->rest();
 26 | }
 27 | 
 28 | function rest1(Seq $xs){
 29 | 	return seq($xs)->rest();
 30 | }
 31 | 
 32 | function rest2(FastSeq $xs){
 33 | 	return $xs->rest;
 34 | }
 35 | 
 36 | function pharen_list($a){
 37 | 
 38 | 	$xs = seq(array_slice(func_get_args(), 1));
 39 | 	return cons($a, $xs);
 40 | }
 41 | 
 42 | function butlast($xs){
 43 | 	return take(dec(count($xs)), $xs);
 44 | }
 45 | 
 46 | function last($xs){
 47 | 	return $xs[dec(count($xs))];
 48 | }
 49 | 
 50 | function eq($val1, $val2){
 51 | 	
 52 | 	 Null;
 53 | 	if(($val1 instanceof IPharenComparable)){
 54 | 		return $val1->eq($val2);
 55 | 	}
 56 | 	else if(($val2 instanceof IPharenComparable)){
 57 | 		return $val2->eq($val1);
 58 | 	}
 59 | 	else{
 60 | 		return ($val1 === $val2);
 61 | 	}
 62 | }
 63 | 
 64 | function prn($s){
 65 | 
 66 | 	$other = seq(array_slice(func_get_args(), 1));
 67 | 	$str = ($s . seq_join($other));
 68 | 		print(($str . "\n"));
 69 | 	return NULL;
 70 | }
 71 | 
 72 | function false__question($x){
 73 | 	return (FALSE === $x);
 74 | }
 75 | 
 76 | function true__question($x){
 77 | 	return (TRUE === $x);
 78 | }
 79 | 
 80 | function null__question($x){
 81 | 	return (NULL === $x);
 82 | }
 83 | 
 84 | function zero__question($n){
 85 | 	return ($n === 0);
 86 | }
 87 | 
 88 | function pos__question($n){
 89 | 	return ($n > 0);
 90 | }
 91 | 
 92 | function neg__question($n){
 93 | 	return ($n < 0);
 94 | }
 95 | 
 96 | function odd__question($n){
 97 | 	return (($n % 2) === 1);
 98 | }
 99 | 
100 | function even__question($n){
101 | 	return (($n % 2) === 0);
102 | }
103 | 
104 | function str($s1, $s2){
105 | 	return ($s1 . $s2);
106 | }
107 | 
108 | function identity($x){
109 | 	return $x;
110 | }
111 | 
112 | function inc($x){
113 | 	return (1 + $x);
114 | }
115 | 
116 | function dec($x){
117 | 	return ($x - 1);
118 | }
119 | 
120 | function _home_scriptor_pharenlang__lambdafunc2($args, $__closure_id){
121 | 	$__splatargs = func_get_args();
122 | 	$args = seq(array_slice($__splatargs, 0, count($__splatargs) - 1));
123 | 	$__closure_id = last($__splatargs);
124 | 		$rfs = Lexical::get_lexical_binding('_home_scriptor_pharenlang', 104, '$rfs', isset($__closure_id)?$__closure_id:0);;
125 | 	$init = call_user_func_array(first($rfs), arr($args));
126 | 	return reduce('\apply', $init, rest($rfs));
127 | }
128 | 
129 | function comp(){
130 | 
131 | 	$fs = seq(array_slice(func_get_args(), 0));
132 | 		$__scope_id = Lexical::init_closure("_home_scriptor_pharenlang", 104);
133 | 	$rfs = reverse($fs);
134 | 		Lexical::bind_lexing("_home_scriptor_pharenlang", 104, '$rfs', $rfs);
135 | 	return new \PharenLambda("\\_home_scriptor_pharenlang__lambdafunc2", Lexical::get_closure_id("_home_scriptor_pharenlang", $__scope_id));
136 | }
137 | 
138 | function zero_or_empty__question($n, $xs){
139 | 		if(zero__question($n)){
140 | 		return zero__question($n);
141 | 	}
142 | 	else{
143 | 		return empty__question($xs);
144 | 	}
145 | 
146 | }
147 | 
148 | function empty__question($xs){
149 | 		if((seq($xs) instanceof \PharenEmptyList)){
150 | 				return (seq($xs) instanceof \PharenEmptyList);
151 | 
152 | 	}
153 | 	else{
154 | 				return !(seq($xs));
155 | 
156 | 	}
157 | 
158 | }
159 | 
160 | function empty__question1(Seq $xs){
161 | 		if((seq($xs) instanceof \PharenEmptyList)){
162 | 				return (seq($xs) instanceof \PharenEmptyList);
163 | 
164 | 	}
165 | 	else{
166 | 				return !(seq($xs));
167 | 
168 | 	}
169 | 
170 | }
171 | 
172 | function empty__question2(FastSeq $xs){
173 | 	return ($xs->length === 0);
174 | }
175 | 
176 | function seq__question($x){
177 | 		return ($x instanceof IPharenSeq);
178 | 
179 | }
180 | 
181 | function seq__question1(Seq $x){
182 | 	return TRUE;
183 | }
184 | 
185 | function sequential__question($x){
186 | 		if(($x instanceof IPharenSeq)){
187 | 				return ($x instanceof IPharenSeq);
188 | 
189 | 	}
190 | 	else{
191 | 		return is_array($x);
192 | 	}
193 | 
194 | }
195 | 
196 | function assoc__question($x){
197 | 		return ($x instanceof PharenHashMap);
198 | 
199 | }
200 | 
201 | function seq($x){
202 | 	if(($x instanceof IPharenSeq)){
203 | 		return $x->seq();
204 | 	}
205 | 	else{
206 | 		return PharenList::seqify($x);
207 | 	}
208 | }
209 | 
210 | function seq1(Seq $x){
211 | 	return $x;
212 | }
213 | 
214 | function seq2(FastSeq $x){
215 | 	return $x;
216 | }
217 | 
218 | function hashify($x){
219 | 	if(($x instanceof PharenHashMap)){
220 | 		return $x;
221 | 	}
222 | 	else{
223 | 		return new PharenHashMap($x);
224 | 	}
225 | }
226 | 
227 | function _home_scriptor_pharenlang__lambdafunc3($pair, $hm, $__closure_id){
228 | 	return assoc($pair[0], $pair[1], $hm);
229 | }
230 | 
231 | function hash_from_pairs($pairs){
232 | 
233 | 
234 | 	return reduce(new \PharenLambda("\\_home_scriptor_pharenlang__lambdafunc3", Lexical::get_closure_id("_home_scriptor_pharenlang", Null)), hashify(array()), $pairs);
235 | }
236 | 
237 | function force($x){
238 | 	return $x->force();
239 | }
240 | 
241 | function realized__question($x){
242 | 	return $x->realized();
243 | }
244 | 
245 | function arr($x){
246 | 	
247 | 	 Null;
248 | 	if(is_array($x)){
249 | 		return $x;
250 | 	}
251 | 	else if(($x instanceof PharenHashMap)){
252 | 		return $x->arr();
253 | 	}
254 | 	else if(($x instanceof IPharenSeq)){
255 | 		return $x->arr();
256 | 	}
257 | }
258 | 
259 | function first_pair($xs){
260 | 	return array_slice($xs, 0, 1);
261 | }
262 | 
263 | function cons($x, $xs){
264 | 	if(seq__question($xs)){
265 | 		return $xs->cons($x);
266 | 	}
267 | 	else{
268 | 		return seq($xs)->cons($x);
269 | 	}
270 | }
271 | 
272 | function cons1($x,Seq $xs){
273 | 	if(TRUE){
274 | 		return $xs->cons($x);
275 | 	}
276 | 	else{
277 | 		return $xs->cons($x);
278 | 	}
279 | }
280 | 
281 | function assoc($key, $val, $hm){
282 | 	return hashify($hm)->assoc($key, $val);
283 | }
284 | 
285 | function get($key, $hm){
286 | 	if(isset($hm[$key])){
287 | 		return $hm[$key];
288 | 	}
289 | 	else{
290 | 		return NULL;
291 | 	}
292 | }
293 | 
294 | function take($n, $xs){
295 | 	if(zero_or_empty__question($n, $xs)){
296 | 		return \PharenVector::create_from_array(array());
297 | 	}
298 | 	else{
299 | 		return cons(first($xs), take(($n - 1), rest($xs)));
300 | 	}
301 | }
302 | 
303 | function drop($n, $xs){
304 | 	while(1){
305 | 		if(zero_or_empty__question($n, $xs)){
306 | 				return $xs;
307 | 		}
308 | 		$__tailrecursetmp0 = ($n - 1);
309 | 		$__tailrecursetmp1 = rest($xs);
310 | 		$n = $__tailrecursetmp0;
311 | 		$xs = $__tailrecursetmp1;
312 | 	}
313 | }
314 | 
315 | function reverse($xs, $acc=array()){
316 | 	while(1){
317 | 		if(empty__question($xs)){
318 | 				return $acc;
319 | 		}
320 | 		$__tailrecursetmp0 = rest($xs);
321 | 		$__tailrecursetmp1 = cons(first($xs), $acc);
322 | 		$xs = $__tailrecursetmp0;
323 | 		$acc = $__tailrecursetmp1;
324 | 	}
325 | }
326 | 
327 | function interpose($sep, $xs, $acc=array()){
328 | 	if((count($xs) === 1)){
329 | 		return \PharenVector::create_from_array(array(first($xs)));
330 | 	}
331 | 	else{
332 | 		return cons(first($xs), cons($sep, interpose($sep, rest($xs))));
333 | 	}
334 | }
335 | 
336 | function partition($n, $xs){
337 | 	if(empty__question($xs)){
338 | 		return $xs;
339 | 	}
340 | 	else{
341 | 		return cons(take($n, $xs), partition($n, drop($n, $xs)));
342 | 	}
343 | }
344 | 
345 | function interleave($xs, $ys){
346 | 		
347 | 		$__condtmpvar0 = Null;
348 | 		if(empty__question($xs)){
349 | 			$__condtmpvar0 = empty__question($xs);
350 | 		}
351 | 		else{
352 | 			$__condtmpvar0 = empty__question($ys);
353 | 		}
354 | 	if($__condtmpvar0){
355 | 		return \PharenVector::create_from_array(array());
356 | 	}
357 | 	else{
358 | 		return cons(first($xs), cons(first($ys), interleave(rest($xs), rest($ys))));
359 | 	}
360 | }
361 | 
362 | function zip_with($f, $xs, $ys){
363 | 	$__scope_id = Lexical::init_closure("_home_scriptor_pharenlang", 144);
364 | 	Lexical::bind_lexing("_home_scriptor_pharenlang", 144, '$f', $f);
365 | 		
366 | 		$__condtmpvar1 = Null;
367 | 		if(empty__question($xs)){
368 | 			$__condtmpvar1 = empty__question($xs);
369 | 		}
370 | 		else{
371 | 			$__condtmpvar1 = empty__question($ys);
372 | 		}
373 | 	if($__condtmpvar1){
374 | 		return \PharenVector::create_from_array(array());
375 | 	}
376 | 	else{
377 | 		return cons($f(first($xs), first($ys)), zip_with($f, rest($xs), rest($ys)));
378 | 	}
379 | }
380 | 
381 | function pharen_sort($xs){
382 | 	$arr = arr($xs);
383 | 	pharen_sort($arr);
384 | 	return $arr;
385 | }
386 | 
387 | function seq_join($xs, $glue=""){
388 | 	return implode($glue, arr($xs));
389 | }
390 | 
391 | function seq_rand($xs){
392 | 	return $xs[rand(0, dec(count($xs)))];
393 | }
394 | 
395 | function _home_scriptor_pharenlang__lambdafunc5($__closure_id){
396 | 	$n = Lexical::get_lexical_binding('_home_scriptor_pharenlang', 149, '$n', isset($__closure_id)?$__closure_id:0);;
397 | 	return cons($n, infinity(($n + 1)));
398 | }
399 | 
400 | function infinity($n=0){
401 | 	$__scope_id = Lexical::init_closure("_home_scriptor_pharenlang", 149);
402 | 	Lexical::bind_lexing("_home_scriptor_pharenlang", 149, '$n', $n);
403 | 		
404 | 
405 | 	return new \PharenLazyList(new \PharenLambda("\\_home_scriptor_pharenlang__lambdafunc5", Lexical::get_closure_id("_home_scriptor_pharenlang", $__scope_id)));
406 | 
407 | 
408 | }
409 | 
410 | function _home_scriptor_pharenlang__lambdafunc6($__closure_id){
411 | 	$x = Lexical::get_lexical_binding('_home_scriptor_pharenlang', 151, '$x', isset($__closure_id)?$__closure_id:0);;
412 | 	return cons($x, repeat($x));
413 | }
414 | 
415 | function repeat($x){
416 | 	$__scope_id = Lexical::init_closure("_home_scriptor_pharenlang", 151);
417 | 	Lexical::bind_lexing("_home_scriptor_pharenlang", 151, '$x', $x);
418 | 		
419 | 
420 | 	return new \PharenLazyList(new \PharenLambda("\\_home_scriptor_pharenlang__lambdafunc6", Lexical::get_closure_id("_home_scriptor_pharenlang", $__scope_id)));
421 | 
422 | 
423 | }
424 | 
425 | function _home_scriptor_pharenlang__lambdafunc7($__closure_id){
426 | 	$f = Lexical::get_lexical_binding('_home_scriptor_pharenlang', 153, '$f', isset($__closure_id)?$__closure_id:0);;
427 | 	return cons($f(), repeatedly($f));
428 | }
429 | 
430 | function repeatedly($f){
431 | 	$__scope_id = Lexical::init_closure("_home_scriptor_pharenlang", 153);
432 | 	Lexical::bind_lexing("_home_scriptor_pharenlang", 153, '$f', $f);
433 | 		
434 | 
435 | 	return new \PharenLazyList(new \PharenLambda("\\_home_scriptor_pharenlang__lambdafunc7", Lexical::get_closure_id("_home_scriptor_pharenlang", $__scope_id)));
436 | 
437 | 
438 | }
439 | 
440 | function _home_scriptor_pharenlang__lambdafunc8($__closure_id){
441 | 	$init = Lexical::get_lexical_binding('_home_scriptor_pharenlang', 155, '$init', isset($__closure_id)?$__closure_id:0);;
442 | 	$f = Lexical::get_lexical_binding('_home_scriptor_pharenlang', 155, '$f', isset($__closure_id)?$__closure_id:0);;
443 | 	return cons($init, iterate($f, $f($init)));
444 | }
445 | 
446 | function iterate($f, $init){
447 | 	$__scope_id = Lexical::init_closure("_home_scriptor_pharenlang", 155);
448 | 	Lexical::bind_lexing("_home_scriptor_pharenlang", 155, '$f', $f);
449 | 	Lexical::bind_lexing("_home_scriptor_pharenlang", 155, '$init', $init);
450 | 		
451 | 
452 | 	return new \PharenLazyList(new \PharenLambda("\\_home_scriptor_pharenlang__lambdafunc8", Lexical::get_closure_id("_home_scriptor_pharenlang", $__scope_id)));
453 | 
454 | 
455 | }
456 | 
457 | function _home_scriptor_pharenlang__lambdafunc9($__closure_id){
458 | 	$xs = Lexical::get_lexical_binding('_home_scriptor_pharenlang', 157, '$xs', isset($__closure_id)?$__closure_id:0);;
459 | 	return concat($xs, cycle($xs));
460 | }
461 | 
462 | function cycle($xs){
463 | 	$__scope_id = Lexical::init_closure("_home_scriptor_pharenlang", 157);
464 | 	Lexical::bind_lexing("_home_scriptor_pharenlang", 157, '$xs', $xs);
465 | 		
466 | 
467 | 	return new \PharenLazyList(new \PharenLambda("\\_home_scriptor_pharenlang__lambdafunc9", Lexical::get_closure_id("_home_scriptor_pharenlang", $__scope_id)));
468 | 
469 | 
470 | }
471 | 
472 | function _home_scriptor_pharenlang__lambdafunc10($__closure_id){
473 | 		$f = Lexical::get_lexical_binding('_home_scriptor_pharenlang', 159, '$f', isset($__closure_id)?$__closure_id:0);;
474 | 		$xs = Lexical::get_lexical_binding('_home_scriptor_pharenlang', 159, '$xs', isset($__closure_id)?$__closure_id:0);;
475 | 	$new_xs = map($f, $xs);
476 | 	return concat($xs, cycle_with($f, $new_xs));
477 | }
478 | 
479 | function cycle_with($f, $xs){
480 | 	$__scope_id = Lexical::init_closure("_home_scriptor_pharenlang", 159);
481 | 	Lexical::bind_lexing("_home_scriptor_pharenlang", 159, '$f', $f);
482 | 	Lexical::bind_lexing("_home_scriptor_pharenlang", 159, '$xs', $xs);
483 | 		
484 | 
485 | 	return new \PharenLazyList(new \PharenLambda("\\_home_scriptor_pharenlang__lambdafunc10", Lexical::get_closure_id("_home_scriptor_pharenlang", $__scope_id)));
486 | 
487 | 
488 | }
489 | 
490 | function vals($m){
491 | 	return array_values(arr($m));
492 | }
493 | 
494 | function append($x, $xs){
495 | 	return concat($xs, \PharenVector::create_from_array(array($x)));
496 | }
497 | 
498 | function apply($f){
499 | 
500 | 	$args = seq(array_slice(func_get_args(), 1));
501 | 	
502 | 	$__condtmpvar2 = Null;
503 | 	if(is_array($f)){
504 | 		$__condtmpvar2 = $f[0];
505 | 	}
506 | 	else{
507 | 		$__condtmpvar2 = $f;
508 | 	}
509 | 	$name = $__condtmpvar2;
510 | 	
511 | 	$__condtmpvar3 = Null;
512 | 	if(sequential__question(last($args))){
513 | 		$__condtmpvar3 = concat(butlast($args), last($args));
514 | 	}
515 | 	else{
516 | 		$__condtmpvar3 = $args;
517 | 	}
518 | 	$args_array = arr($__condtmpvar3);
519 | 		if(is_array($f)){
520 | 		array_push($args_array, $f[1]);
521 | 	}
522 | 	else{
523 | 		NULL;
524 | 	}
525 | 
526 | 	return call_user_func_array($name, $args_array);
527 | }
528 | 
529 | function _home_scriptor_pharenlang__lambdafunc11($x, $y, $__closure_id){
530 | 	$f = Lexical::get_lexical_binding('_home_scriptor_pharenlang', 166, '$f', isset($__closure_id)?$__closure_id:0);;
531 | 	return $f($y, $x);
532 | }
533 | 
534 | function flip($f){
535 | 	$__scope_id = Lexical::init_closure("_home_scriptor_pharenlang", 166);
536 | 	Lexical::bind_lexing("_home_scriptor_pharenlang", 166, '$f', $f);
537 | 	return new \PharenLambda("\\_home_scriptor_pharenlang__lambdafunc11", Lexical::get_closure_id("_home_scriptor_pharenlang", $__scope_id));
538 | }
539 | 
540 | function _home_scriptor_pharenlang__lambdafunc13($f, $__closure_id){
541 | 	$args = Lexical::get_lexical_binding('_home_scriptor_pharenlang', 169, '$args', isset($__closure_id)?$__closure_id:0);;
542 | 	return apply($f, $args);
543 | }
544 | 
545 | function _home_scriptor_pharenlang__lambdafunc12($args, $__closure_id){
546 | 	$__splatargs = func_get_args();
547 | 	$args = seq(array_slice($__splatargs, 0, count($__splatargs) - 1));
548 | 	$__closure_id = last($__splatargs);
549 | 	$__scope_id = Lexical::init_closure("_home_scriptor_pharenlang", 169);
550 | 	Lexical::bind_lexing("_home_scriptor_pharenlang", 169, '$args', $args);
551 | 	$fs = Lexical::get_lexical_binding('_home_scriptor_pharenlang', 168, '$fs', isset($__closure_id)?$__closure_id:0);;
552 | 
553 | 
554 | 
555 | 
556 | 	return map(new \PharenLambda("\\_home_scriptor_pharenlang__lambdafunc13", Lexical::get_closure_id("_home_scriptor_pharenlang", $__scope_id)), $fs);
557 | }
558 | 
559 | function juxt(){
560 | 
561 | 	$fs = seq(array_slice(func_get_args(), 0));
562 | 	$__scope_id = Lexical::init_closure("_home_scriptor_pharenlang", 168);
563 | 	Lexical::bind_lexing("_home_scriptor_pharenlang", 168, '$fs', $fs);
564 | 	return new \PharenLambda("\\_home_scriptor_pharenlang__lambdafunc12", Lexical::get_closure_id("_home_scriptor_pharenlang", $__scope_id));
565 | }
566 | 
567 | function concat($xs1, $xs2){
568 | 
569 | 
570 | 	if(empty__question($xs1)){
571 | 		return $xs2;
572 | 	}
573 | 	else{
574 | 		return cons(first($xs1), concat(rest($xs1), $xs2));
575 | 	}
576 | }
577 | 
578 | function into($to, $from){
579 | 	return reduce('\cons', $to, $from);
580 | }
581 | 
582 | function reduce($f, $acc, $xs){
583 | 	$__scope_id = Lexical::init_closure("_home_scriptor_pharenlang", 173);
584 | 	Lexical::bind_lexing("_home_scriptor_pharenlang", 173, '$f', $f);
585 | 	while(1){
586 | 		if(empty__question($xs)){
587 | 				return $acc;
588 | 		}
589 | 		$__tailrecursetmp1 = $f(first($xs), $acc);
590 | 		$__tailrecursetmp2 = rest($xs);
591 | 		$acc = $__tailrecursetmp1;
592 | 		$xs = $__tailrecursetmp2;
593 | 	}
594 | }
595 | 
596 | function reduce1($f, $acc,Seq $xs){
597 | 	$__scope_id = Lexical::init_closure("_home_scriptor_pharenlang", 174);
598 | 	Lexical::bind_lexing("_home_scriptor_pharenlang", 174, '$f', $f);
599 | 	while(1){
600 | 	$__inline_result0 = Null;
601 | 	if(($xs instanceof \PharenEmptyList)){
602 | 				$__inline_result0 = $xs instanceof \PharenEmptyList;
603 | 	}
604 | 	else{
605 | 				$__inline_result0 = !($xs);
606 | 	}
607 | 
608 | 		if($__inline_result0){
609 | 					return $acc;
610 | 		}
611 | 		$__tailrecursetmp1 = $f($xs->first(), $acc);
612 | 		$__tailrecursetmp2 = $xs->rest();
613 | 		$acc = $__tailrecursetmp1;
614 | 		$xs = $__tailrecursetmp2;
615 | 	}
616 | }
617 | 
618 | function reduce2($f, $acc,FastSeq $xs){
619 | 	$__scope_id = Lexical::init_closure("_home_scriptor_pharenlang", 175);
620 | 	Lexical::bind_lexing("_home_scriptor_pharenlang", 175, '$f', $f);
621 | 	while(1){
622 | 		if($xs->length === 0){
623 | 						return $acc;
624 | 		}
625 | 		$__tailrecursetmp1 = $f($xs->first, $acc);
626 | 		$__tailrecursetmp2 = $xs->rest;
627 | 		$acc = $__tailrecursetmp1;
628 | 		$xs = $__tailrecursetmp2;
629 | 	}
630 | }
631 | 
632 | function reduce_fns($fns, $acc, $xs){
633 | 	while(1){
634 | 		if(empty__question($xs)){
635 | 				return $acc;
636 | 		}
637 | 			$__tmpfuncname1 = first($fns);
638 | 		$__tailrecursetmp0 = rest($fns);
639 | 		$__tailrecursetmp1 = $__tmpfuncname1(first($xs), $acc);
640 | 		$__tailrecursetmp2 = rest($xs);
641 | 		$fns = $__tailrecursetmp0;
642 | 		$acc = $__tailrecursetmp1;
643 | 		$xs = $__tailrecursetmp2;
644 | 	}
645 | }
646 | 
647 | function _home_scriptor_pharenlang__lambdafunc14($val, $acc, $__closure_id){
648 | 	$new_val_func = Lexical::get_lexical_binding('_home_scriptor_pharenlang', 177, '$new_val_func', isset($__closure_id)?$__closure_id:0);;
649 | 	return ($acc . $new_val_func($val));
650 | }
651 | 
652 | function reduce_to_str($new_val_func, $xs){
653 | 	$__scope_id = Lexical::init_closure("_home_scriptor_pharenlang", 177);
654 | 	Lexical::bind_lexing("_home_scriptor_pharenlang", 177, '$new_val_func', $new_val_func);
655 | 
656 | 
657 | 	return reduce(new \PharenLambda("\\_home_scriptor_pharenlang__lambdafunc14", Lexical::get_closure_id("_home_scriptor_pharenlang", $__scope_id)), "", $xs);
658 | }
659 | 
660 | function reduce_pairs($f, $acc, $xs){
661 | 	$__scope_id = Lexical::init_closure("_home_scriptor_pharenlang", 179);
662 | 	Lexical::bind_lexing("_home_scriptor_pharenlang", 179, '$f', $f);
663 | 	while(1){
664 | 		if(empty__question($xs)){
665 | 				return $acc;
666 | 		}
667 | 		$__tailrecursetmp1 = $f(each($xs), $acc);
668 | 		$__tailrecursetmp2 = rest($xs);
669 | 		$acc = $__tailrecursetmp1;
670 | 		$xs = $__tailrecursetmp2;
671 | 	}
672 | }
673 | 
674 | function map($f, $xs){
675 | 	$__scope_id = Lexical::init_closure("_home_scriptor_pharenlang", 180);
676 | 	Lexical::bind_lexing("_home_scriptor_pharenlang", 180, '$f', $f);
677 | 	if(empty__question($xs)){
678 | 		return $xs;
679 | 	}
680 | 	else{
681 | 		return cons($f(first($xs)), map($f, rest($xs)));
682 | 	}
683 | }
684 | 
685 | function filter($f, $coll){
686 | 	if(empty__question($coll)){
687 | 		return \PharenVector::create_from_array(array());
688 | 	}
689 | 	else{
690 | 		$x = first($coll);
691 | 		$xs = rest($coll);
692 | 		if(!($f($x))){
693 | 			return filter($f, $xs);
694 | 		}
695 | 		else{
696 | 			return cons($x, filter($f, $xs));
697 | 		}
698 | 	}
699 | }
700 | 
701 | function until($f, $xs){
702 | 	$__scope_id = Lexical::init_closure("_home_scriptor_pharenlang", 183);
703 | 	Lexical::bind_lexing("_home_scriptor_pharenlang", 183, '$f', $f);
704 | 	while(1){
705 | 		
706 | 		 Null;
707 | 		if(empty__question($xs)){
708 | 				return FALSE;
709 | 		}
710 | 		else if($result = $f(first($xs))){
711 | 				return $result;
712 | 		}
713 | 		$__tailrecursetmp1 = rest($xs);
714 | 		$xs = $__tailrecursetmp1;
715 | 	}
716 | }
717 | 
718 | function map_indexed($f, $xs, $idx=0){
719 | 	$__scope_id = Lexical::init_closure("_home_scriptor_pharenlang", 184);
720 | 	Lexical::bind_lexing("_home_scriptor_pharenlang", 184, '$f', $f);
721 | 	if(empty__question($xs)){
722 | 		return \PharenVector::create_from_array(array());
723 | 	}
724 | 	else{
725 | 		return cons($f(first($xs), $idx), map_indexed($f, rest($xs), inc($idx)));
726 | 	}
727 | }
728 | 
729 | function _home_scriptor_pharenlang__lambdafunc15($pair, $acc, $__closure_id){
730 | 	$f = Lexical::get_lexical_binding('_home_scriptor_pharenlang', 185, '$f', isset($__closure_id)?$__closure_id:0);;
731 | 	return append($f($pair[0], $pair[1]), $acc);
732 | }
733 | 
734 | function map_pairs($f, $pairs){
735 | 	$__scope_id = Lexical::init_closure("_home_scriptor_pharenlang", 185);
736 | 	Lexical::bind_lexing("_home_scriptor_pharenlang", 185, '$f', $f);
737 | 
738 | 
739 | 	return reduce_pairs(new \PharenLambda("\\_home_scriptor_pharenlang__lambdafunc15", Lexical::get_closure_id("_home_scriptor_pharenlang", $__scope_id)), \PharenVector::create_from_array(array()), $pairs);
740 | }
741 | 
742 | function repling(){
743 | 		
744 | 	 Null;
745 | 	if(!(defined("PHARENREPLMODE"))){
746 | 		return defined("PHARENREPLMODE");
747 | 	}
748 | 	else if(!(constant("PHARENREPLMODE"))){
749 | 		return constant("PHARENREPLMODE");
750 | 	}
751 | 	else{
752 | 		return constant("PHARENREPLMODE");
753 | 	}
754 | 
755 | }
756 | 
757 | class MultiManager{
758 | 	static $multis = NULL;
759 | 	static function matching_multi_exists($multi_name, $serialized_args){
760 | 		return isset(self::$multis[$multi_name][$serialized_args]);
761 | 	}
762 | 	
763 | 	static function get_matching_multi($multi_name, $serialized_args){
764 | 		return self::$multis[$multi_name][$serialized_args];
765 | 	}
766 | 	
767 | 	static function set_multi($multi_name, $pattern, $f){
768 | 		return (self::$multis[$multi_name][$pattern] = $f);
769 | 	}
770 | 	
771 | }
772 | MultiManager::$multis = hashify(array());
773 | function _home_scriptor_pharenlang__lambdafunc16($val, $__closure_id){
774 | 	
775 | 	 Null;
776 | 	if(is_string($val)){
777 | 		return "str";
778 | 	}
779 | 	else if(is_int($val)){
780 | 		return "int";
781 | 	}
782 | 	else if(is_float($val)){
783 | 		return "float";
784 | 	}
785 | 	else if(is_bool($val)){
786 | 		return "bool";
787 | 	}
788 | 	else if(is_array($val)){
789 | 		if(isset($val["_multitype"])){
790 | 			return $val["_multitype"];
791 | 		}
792 | 		else{
793 | 			return "5";
794 | 		}
795 | 	}
796 | 	else if(is_object($val)){
797 | 		return get_class($val);
798 | 	}
799 | }
800 | 
801 | function multi_serialize_args($vals){
802 | 
803 | 
804 | 	return reduce_to_str(new \PharenLambda("\\_home_scriptor_pharenlang__lambdafunc16", Lexical::get_closure_id("_home_scriptor_pharenlang", Null)), $vals);
805 | }
806 | 
807 | function multi_serialize_pattern($pattern){
808 | 	return implode(arr($pattern));
809 | }
810 | 
811 | function get_multi($name, $args){
812 | 	$serialized_args = multi_serialize_args($args);
813 | 	if(MultiManager::matching_multi_exists($name, $serialized_args)){
814 | 		return MultiManager::get_matching_multi($name, $serialized_args);
815 | 	}
816 | 	else{
817 | 		return "No matching pattern";
818 | 	}
819 | }
820 | 
821 | 


--------------------------------------------------------------------------------
/lexical.php:
--------------------------------------------------------------------------------
 1 | <?php
 2 | namespace Pharen;
 3 | class Lexical{
 4 |     static $scopes = array();
 5 | 
 6 |     public static function init_closure($ns, $id){
 7 |         if(isset(self::$scopes[$ns][$id])){
 8 |             self::$scopes[$ns][$id][] = array();
 9 |         }else{
10 |             self::$scopes[$ns][$id] = array(array());
11 |         }
12 |         return $id;
13 |     }
14 | 
15 |     public static function get_closure_id($ns, $id){
16 |         if($id === Null){
17 |             return Null;
18 |         }else{
19 |             return count(self::$scopes[$ns][$id])-1;
20 |         }
21 |     }
22 | 
23 |     public static function bind_lexing($ns, $id, $var, &$val){
24 |         $closure_id = self::get_closure_id($ns, $id);
25 |         self::$scopes[$ns][$id][$closure_id][$var] =& $val;
26 |         return $val;
27 |     }
28 | 
29 |     public static function get_lexical_binding($ns, $id, $var, $closure_id){
30 |         return self::$scopes[$ns][$id][$closure_id][$var];
31 |     }
32 | }
33 | 


--------------------------------------------------------------------------------
/lib/phake/builtins.phn:
--------------------------------------------------------------------------------
 1 | (use pharen.phake as phake)
 2 | 
 3 | (fn replace-placeholders (file &repls)
 4 |   (let [contents (file-get-contents file)
 5 |         replace (lambda (repl contents)
 6 |                         (let [placeholder (. "{" (:repl 0) "}")
 7 |                               replacement (:repl 1)]
 8 |                           (str-replace placeholder replacement contents)))]
 9 |     (file-put-contents file (reduce replace contents repls))))
10 | 
11 | (task "create" "Creating new project..."
12 |       (keyword-call global $argv)
13 |       (let [name (:argv 2)
14 |             name-arg (escapeshellarg name)
15 |             default-dir (. phake.PHAKE_SYSTEM "/templates/default/")
16 |             proj-dir (. (getcwd) "/" name "/")]
17 |         (exec (. "cp -r " default-dir " " name-arg))
18 |         (let
19 |           [phakefile (. proj-dir "/phakefile")
20 |            testsfile (. proj-dir "/test/tests.phn")
21 |            mainfile (. proj-dir "/" name ".phn")
22 |            replacements ["project-name" name]]
23 |           (rename (. proj-dir "/main.phn") mainfile)
24 |           (replace-placeholders mainfile replacements)
25 |           (replace-placeholders testsfile replacements)
26 |           (replace-placeholders phakefile replacements))))
27 | 


--------------------------------------------------------------------------------
/lib/phake/phake.phn:
--------------------------------------------------------------------------------
 1 | (ns pharen.phake)
 2 | (use pharen.path as path)
 3 | (define "pharen\phake\PHAKE_SYSTEM" (realpath (dirname __FILE__)))
 4 | (define "pharen\phake\PHAREN_SYSTEM" (path.join PHAKE-SYSTEM "../.."))
 5 | (define "pharen\phake\PROJECT_SYSTEM" (getcwd))
 6 | 
 7 | (require-once (. PHAREN-SYSTEM "/pharen.php"))
 8 | (compile-lang)
 9 | 
10 | (fn proj (name attrs)
11 |   "Do stuff with project info here")
12 | 
13 | (fn project-path ([f ""])
14 |   (str-replace "\\" "/" (path.join PROJECT-SYSTEM f)))
15 | 
16 | (fn not-dots (dir)
17 |   (and (!== "." dir) (!== ".." dir)))
18 | 
19 | (fn compile-with-flag (flag file)
20 |   (set-flag flag)
21 |   (compile-file file)
22 |   (unset-flag flag))
23 | 
24 | (fn compile-except (excepts file [output-dir NULL])
25 |   (when (not (in-array file (arr excepts)))
26 |     (compile-file file)))
27 | 
28 | (fn is-phn (f)
29 |   (let [pathinfo (pathinfo f)]
30 |     (and (isset (:pathinfo "extension"))
31 |          (== (:pathinfo "extension") "phn"))))
32 | 
33 | (fn compile-dir (dir [compile-func #compile-file])
34 |   (map 
35 |     (lambda (f)
36 |             (def file (path.join dir f))
37 |             (cond
38 |               ((and (not-dots f) (is-dir file)) (compile-dir file compile-func))
39 |               ((is-phn file) (do
40 |                                ($compile-func file (dirname file))
41 |                                (print (. "Compiled " file "\n"))))))
42 |     (scandir dir 1)))
43 | 
44 | 
45 | (defmacro task (name desc &body)
46 |   (def name-str name)
47 |   '(fn ~name () 
48 |      (print (. "Running " ~name-str ": " ~desc "\n"))
49 |       ~@body))
50 | 
51 | (compile-with-flag "executable" (. PHAKE-SYSTEM "/phake.phn"))
52 | (compile-file (. PHAKE-SYSTEM "/builtins.phn"))
53 | (require (. PHAKE-SYSTEM "/builtins.php"))
54 | 
55 | (def phakefile (project-path "/phakefile"))
56 | (when (file-exists phakefile)
57 |   (compile-file phakefile)
58 |   (require (. phakefile ".php")))
59 | 
60 | (if (> (count argv) 1)
61 |   ((:argv 1))
62 |   (print "Doing nothing\n"))
63 | 


--------------------------------------------------------------------------------
/lib/phake/phakefile:
--------------------------------------------------------------------------------
 1 | (proj "Phake"
 2 |       {"description" "A built and automation tool written in Pharen."
 3 |        "version" "0.0.1"})
 4 | 
 5 | (task "build" "Compile Phake project files to PHP."
 6 |       (compile-file (. PHAKE-SYSTEM "/phake.phn")))
 7 | 
 8 | (task "test" "Test Phake library."
 9 |       (def tests-file (. PHAKE-SYSTEM "/test/phake_tests"))
10 |       (compile-file (. tests-file ".phn"))
11 |       (require (. tests-file ".php")))
12 | 


--------------------------------------------------------------------------------
/lib/phake/templates/default/main.phn:
--------------------------------------------------------------------------------
1 | (ns {project-name})
2 | 
3 | ; Main project code goes here
4 | (prn "Hello, world!")
5 | 


--------------------------------------------------------------------------------
/lib/phake/templates/default/phakefile:
--------------------------------------------------------------------------------
 1 | (use pharen.phake as phake)
 2 | 
 3 | (phake.proj "{project-name}"
 4 |             {"description" "Enter your description here"
 5 |              "version" "<version>"})
 6 | 
 7 | (task "build" "Building {project-name}"
 8 |       (compile-file (phake.project-path "{project-name}.phn")))
 9 | 
10 | (task "run" "Beginning run sequence for {project-name}"
11 |       (build)
12 |       (require (phake.project-path "{project-name}.php")))
13 | 
14 | (task "test" "Testing {project-name}..."
15 |       (compile-file (phake.project-path "/test/tests.phn"))
16 |       (require (phake.project-path "/test/tests.php"))
17 |       TRUE)
18 | 
19 | 


--------------------------------------------------------------------------------
/lib/phake/templates/default/test/tests.phn:
--------------------------------------------------------------------------------
1 | (ns {project-name}.tests)
2 | (use pharen.test as test)
3 | (use {project-name})
4 | 
5 | (define "TESTS_DIR" (dirname __FILE__))
6 | 
7 | ; Your tests should go below
8 | (test.it "No tests written, yet." (test.check 1 1))
9 | 


--------------------------------------------------------------------------------
/lib/pharen/bench.phn:
--------------------------------------------------------------------------------
 1 | (use pharen.stats as stats)
 2 | 
 3 | (defmacro trial (expr)
 4 |   '(let [time-start (microtime TRUE)
 5 |          result ~expr
 6 |          time-duration (- (microtime TRUE) time-start)]
 7 |      time-duration))
 8 | 
 9 | (defmacro bench (name expr)
10 |   '(let [n 10
11 |          times []]
12 |      (local times (dotimes [i n]
13 |                              (local t (trial ~expr))
14 |                              (set! times (cons t times))))
15 |      (prn (generate-report ~name n times))
16 |      {:name ~name :times times}))
17 | 
18 | (fn pretty (t)
19 |   (if (> t 1000)
20 |     (. (sprintf "%.4f" t) " seconds")
21 |     (. (sprintf "%.4f" (* 1000 t)) " ms")))
22 | 
23 | (fn generate-report (name n ^Seq times)
24 |   (let [mean (stats.mean times)
25 |         median (stats.median times)
26 |         max (stats.max times)
27 |         min (stats.min times)
28 |         std-dev (stats.std-dev times)
29 |         plusmin (round (* (/ (* 2 std-dev) mean) 100) 2)
30 |         header (. "Benchmarking " name " - " n " trials:")]
31 |     (. header "\n"
32 |        (str-repeat "=" (strlen header)) "\n"
33 |        "Mean:\t "   (pretty mean) " +/- " plusmin "%\n"
34 |        "Median:\t " (pretty median) "\n"
35 |        "Max:\t "    (pretty max) "\n"
36 |        "Min:\t "    (pretty min) "\n"
37 |        "Std dev: " (pretty std-dev) "\n"
38 |        )))
39 | 
40 | (fn get-diffs (xs ys)
41 |   (map-indexed (lambda (x i)
42 |                        (- x (:ys i)))
43 |                xs))
44 | (fn get-perc (x y)
45 |   (round (* (/ (abs x) (abs y)) 100) 2))
46 | 
47 | (fn compare-benches (b1 b2)
48 |   (let [name1 (:b1 :name)
49 |         name2 (:b2 :name)
50 |         times1 (:b1 :times) ^Seq
51 |         times2 (:b2 :times) ^Seq
52 |         mean1 (stats.mean times1)
53 |         mean2 (stats.mean times2)
54 |         diffs (get-diffs times1 times2) ^Seq
55 |         mean-diffs (stats.mean diffs)
56 |         header (. "Comparing " name1 " and " name2)]
57 |     (prn (.
58 |           header "\n"
59 |           (str-repeat "=" (strlen header)) "\n"
60 |           (if (neg? mean-diffs) ; b1 is faster
61 |             (. name1 " is on average faster by "
62 |                (get-perc mean-diffs mean2) "%")
63 |             (. name2 " is on average faster by "
64 |                (get-perc mean-diffs mean2) "%"))
65 |           "\n"))))
66 | 


--------------------------------------------------------------------------------
/lib/pharen/html.phn:
--------------------------------------------------------------------------------
 1 | (ns pharen.html)
 2 | (fn html-form (method action &code)
 3 |     (sprintf "<form action='%s' method='%s'>%s</form>" action method (implode "<br/>" code)))
 4 | 
 5 | (fn html-label (id)
 6 |   (sprintf "<label for='%s'>%s</label>" id id))
 7 | 
 8 | (fn html-textbox (id)
 9 |   (sprintf "%s <br/> <input type='text' id='%s' name='%s'/>" (html-label id) id id))
10 | 
11 | (fn html-textarea (id)
12 |     (sprintf "%s <br/> <textarea id='%s' name='%s'></textarea>" (html-label id) id id))
13 | 
14 | (fn html-submit (id)
15 |   (sprintf "%s <br/> <input type='submit' id='%s' name='%s' value='%s'/>" (html-label id) id id id))
16 | 
17 | (fn html-link (url text)
18 |   (sprintf "<a href='%s'>%s</a>" url text))
19 | 


--------------------------------------------------------------------------------
/lib/pharen/lazy.phn:
--------------------------------------------------------------------------------
 1 | (ns pharen.lazy)
 2 | (fn map (f coll)
 3 |   (lazy-seq
 4 |     (if (empty? coll)
 5 |       []
 6 |       (cons ($f (first coll)) (map f (rest coll))))))
 7 | 
 8 | (fn take (n coll)
 9 |   (lazy-seq
10 |     (if (zero-or-empty? n coll)
11 |       []
12 |       (cons (first coll) (take (- n 1) (rest coll))))))
13 | 
14 | (fn interleave (xs ys)
15 |   (lazy-seq
16 |     (if (empty? xs)
17 |       []
18 |       (cons (first xs) (interleave ys (rest xs))))))
19 | 
20 | (fn filter (f coll)
21 |   (lazy-seq
22 |     (if (empty? coll)
23 |       []
24 |       (let [x (first coll), xs (rest coll)]
25 |         (if (not ($f x))
26 |           (filter f xs)
27 |           (cons x (filter f xs)))))))
28 | 


--------------------------------------------------------------------------------
/lib/pharen/path.phn:
--------------------------------------------------------------------------------
 1 | (ns pharen.path)
 2 | ; Structure and protocol for the following was pretty much copied from NodeJS's path library,
 3 | ; the meat is done functionally, however
 4 | (fn path-normalize-array (chunks)
 5 |   (reverse 
 6 |     (reduce (lambda (chunk acc)
 7 |                     (cond
 8 |                       ((empty chunk) (if (empty? acc)
 9 |                                        (cons chunk acc)
10 |                                        acc))
11 |                       ((== ".." chunk) (rest acc))
12 |                       (TRUE (cons chunk acc))))
13 |             []
14 |             chunks)))
15 | 
16 | (fn path-normalize (path)
17 |   (seq-join (path-normalize-array (explode "/" path)) "/"))
18 | 
19 | (fn convert-slashes (path)
20 |   (str-replace "\\" "/" path))
21 | 
22 | (fn join (&paths)
23 |   (path-normalize (convert-slashes (seq-join paths "/"))))
24 | 


--------------------------------------------------------------------------------
/lib/pharen/repl.phn:
--------------------------------------------------------------------------------
  1 | (ns pharen.repl)
  2 | (use pharen.path as path)
  3 | (define "REPL_SYSTEM" (realpath (dirname __FILE__)))
  4 | (define "PHAREN_SYSTEM" (path.join REPL-SYSTEM "../../"))
  5 | 
  6 | (require-once (. PHAREN_SYSTEM "/pharen.php"))
  7 | 
  8 | (def greetings ["Maybe solve P v NP!" "Happy Pharening!" "(map) new worlds!"
  9 |                 "Maybe solve Hello World!" "Curly fries are delicious and cheap!"])
 10 | 
 11 | (fn get-file-vars (file vars)
 12 |   (include-once file)
 13 |   (array-diff-key (get-defined-vars) vars))
 14 | 
 15 | (fn starts-with (needle haystack)
 16 |   (== (substr haystack 0 (strlen needle)) needle))
 17 | 
 18 | (fn get-needle (input)
 19 |   (let [point (:(readline-info) "point")
 20 |         up-to-point (substr input 0 point)
 21 |         last-pound (strrpos up-to-point "#")]
 22 |     (if (not (false? last-pound))
 23 |       (substr up-to-point (inc last-pound))
 24 |       input)))
 25 | 
 26 | (fn prepend-chars (needle funcs)
 27 |   (if-not (false? (strpos needle "#"))
 28 |     (map (lambda (func)
 29 |                  (. "#" func))
 30 |          funcs)
 31 |     funcs))
 32 | 
 33 | (fn strip-ns (funcs)
 34 |   (map (lambda (func)
 35 |                (str-replace (. (:: .RootNode ns) "\\") "" func))
 36 |        funcs))
 37 | 
 38 | (fn pharen-complete-func (input)
 39 |   (let [all-funcs (get-defined-functions)
 40 |         needle (get-needle input)
 41 |         starts-with-input (starts-with needle)
 42 |         internal-matches (prepend-chars input (filter starts-with-input (strip-ns (:all-funcs "internal"))))
 43 |         user-matches (prepend-chars input (filter starts-with-input (strip-ns (:all-funcs "user"))))]
 44 |     (arr (concat user-matches internal-matches))))
 45 | 
 46 | (if (function-exists "readline")
 47 |   (do
 48 |     (fn prompt (prompt)
 49 |       (let [line (trim (readline prompt))]
 50 |         (readline-add-history line)
 51 |         line))
 52 |     (readline-completion-function #pharen-complete-func))
 53 |   (fn prompt (prompt)
 54 |     (fwrite STDOUT prompt)
 55 |     (trim (fgets STDIN))))
 56 | 
 57 | (fn get-prompt (expecting)
 58 |   (let [suffix (if expecting "... " "> ")]
 59 |     (if-let [ns (:: .RootNode raw-ns)]
 60 |         (. ns suffix)
 61 |         (. "pharen" suffix))))
 62 | 
 63 | (fn add-uses (code)
 64 |   (let [use-str (if-let [uses (get (:: .RootNode ns) (:: .RootNode pharen-uses))]
 65 |                   (reduce-to-str 
 66 |                     (lambda (ns)
 67 |                             (if (== (count ns) 2)
 68 |                               (. "(use " (:ns 0) " as " (:ns 1) ")\n")
 69 |                               (. "(use " (:ns 0) ")\n")))
 70 |                     uses)
 71 |                   "")]
 72 |     (. use-str code)))
 73 | 
 74 | (fn fmt-result (x)
 75 |   (let [result (cond
 76 |                 ((=== NULL x) "Null")
 77 |                 ((=== TRUE x) "True")
 78 |                 ((=== FALSE x) "False")
 79 |                 ((is-object x) (if (method-exists x "__toString") x (. "<" (get-class x) ">")))
 80 |                 ((is-string x) (. "\"" x "\""))
 81 |                 (TRUE x))]
 82 |     (if (< 80 (strlen result))
 83 |       (. (substr result 0 80) "...")
 84 |       result)))
 85 | 
 86 | (fn phpfy-ns (ns)
 87 |   (str-replace "-" "_" (str-replace "." "_" ns)))
 88 | 
 89 | (fn wrap-compile (code)
 90 |   (if (=== (trim code) "")
 91 |     ""
 92 |     (let [embedded-code (. "(local *1 " code ") (return *1)")
 93 |           raw-ns (:: .RootNode raw-ns)
 94 |           final-code (add-uses embedded-code)]
 95 |       (compile final-code NULL (phpfy-ns raw-ns) (:: .RootNode last-scope)
 96 |                "<repl>" FALSE))))
 97 | 
 98 | (fn compile-code (code)
 99 |   (local compiled-code (wrap-compile code))
100 |   (if-not (false? compiled-code)
101 |     compiled-code
102 |     FALSE))
103 | 
104 | (fn intro ()
105 |   (. "Initialized Pharen REPL. " (:greetings (array-rand (arr greetings))) "\n"))
106 | 
107 | (fn work ([previous-code ""] [repl-vars []] [prompt #prompt] [prn-result #prn])
108 |   (let [code (. previous-code " " ($prompt (get-prompt previous-code)))]
109 |     (if (== (trim code) "quit")
110 |       FALSE
111 |       (let [compiled-code (compile-code code)]
112 |         (if-not (false? compiled-code)
113 |           (do 
114 |             (extract repl-vars)
115 |             ($prn-result (fmt-result (eval (. "?>" compiled-code))))
116 |             (local previous-code ""))
117 |           (local previous-code code))
118 |         (work previous-code repl-vars prompt prn-result)))))
119 | 


--------------------------------------------------------------------------------
/lib/pharen/sql.phn:
--------------------------------------------------------------------------------
 1 | (ns pharen.sql)
 2 | (fn sql-connect (user pass db)
 3 |   (mysql-connect "localhost" user pass)
 4 |   (mysql-select-db db))
 5 | 
 6 | (fn sql-quote (v)
 7 |   (let [val (mysql-real-escape-string v)]
 8 |     (if (is-string val)
 9 |       (. "'" val "'")
10 |       val)))
11 | 
12 | (fn sql-vals (pairs)
13 |   (implode ", " (map #sql-quote (array-values pairs))))
14 | 
15 | (fn sql-cols (pairs)
16 |   (implode ", " (array-keys pairs)))
17 | 
18 | (fn sql-fetch-by-id (table id)
19 |   (def query (sprintf "SELECT * FROM %s WHERE id=%s;"
20 |                       (mysql-real-escape-string table)
21 |                       (mysql-real-escape-string id)))
22 |   (mysql-fetch-assoc (mysql-query query)))
23 | 
24 | (fn sql-insert (table pairs)
25 |   (mysql-query (sprintf "INSERT INTO %s (%s) VALUES (%s);"
26 |                       (mysql-real-escape-string table)
27 |                       (sql-cols pairs)
28 |                       (sql-vals pairs)))
29 |   (mysql-insert-id))
30 | 


--------------------------------------------------------------------------------
/lib/pharen/stats.phn:
--------------------------------------------------------------------------------
 1 | (ns pharen.stats)
 2 | 
 3 | (fun add (x y)
 4 |      (+ x y))
 5 | (poly-ann reduce (^#add f acc ^Seq xs))
 6 | 
 7 | (fn sum (^Seq xs)
 8 |   (reduce #add 0 xs))
 9 | 
10 | (fn mean (^Seq xs)
11 |   (let [sum (sum xs)]
12 |     (/ sum (count xs))))
13 | 
14 | (fn avg (&nums)
15 |   (ann nums ^Seq)
16 |   (mean nums))
17 | 
18 | (fn median (^Seq xs)
19 |   (let [c (count xs)
20 |         mid (floor (/ c 2))]
21 |     (cond
22 |       ((empty? xs) NULL)
23 |       ((even? c) (avg (:xs (dec mid)) (:xs mid)))
24 |       ((odd? c) (:xs mid)))))
25 | 
26 | (fn min (^Seq xs)
27 |   (reduce #\min (first xs) xs))
28 | 
29 | (fn max (^Seq xs)
30 |   (reduce #\max (first xs) xs))
31 | 
32 | (fn square (x)
33 |   (* x x))
34 | 
35 | (fn std-dev (^Seq xs)
36 |   (let [mean (mean xs)
37 |         c (count xs)
38 |         diffs (map (- mean) xs)
39 |         diffs-sq (map #square diffs)]
40 |     (ann diffs-sq ^Seq)
41 |     (sqrt (/ (sum diffs-sq) c))))
42 | 


--------------------------------------------------------------------------------
/lib/pharen/test.phn:
--------------------------------------------------------------------------------
 1 | (ns pharen.test)
 2 | (fn check (expr expected [backtrace-start 0])
 3 |   (if (eq expr expected)
 4 |     TRUE
 5 |     (do
 6 |       (def bt (debug_backtrace))
 7 |       (error "Test failed on line: " (:bt backtrace-start "line") " in " (:bt backtrace-start "file"))
 8 |       FALSE)))
 9 | 
10 | (fn describe (msg func)
11 |   (echo (. "Running tests for: " msg "\n"))
12 |   ($func))
13 | 
14 | (fn it (msg func)
15 |   (if func
16 |     (print (. "Test passed:\t " msg "\n"))
17 |     (print (. "Test failed:\t " msg "\n"))))
18 | 


--------------------------------------------------------------------------------
/lib/sequence.php:
--------------------------------------------------------------------------------
  1 | <?php
  2 | interface IPharenSeq{
  3 |     public function first();
  4 |     public function rest();
  5 |     public function cons($item);
  6 | }
  7 | class_alias("IPharenSeq", "Seq");
  8 | 
  9 | interface IPharenLazy{
 10 |     public function force();
 11 |     public function realized();
 12 | }
 13 | 
 14 | interface IPharenComparable{
 15 |     public function eq($other);
 16 | }
 17 | 
 18 | interface IPharenHashable{
 19 |     public function hash();
 20 | }
 21 | 
 22 | abstract class FastSeq implements IPharenSeq{
 23 |     public $first;
 24 |     public $rest;
 25 |     public $length;
 26 | 
 27 |     abstract public function first();
 28 |     abstract public function rest();
 29 |     abstract public function cons($item);
 30 | }
 31 | 
 32 | class PharenList extends FastSeq
 33 |     implements IPharenComparable, Countable, ArrayAccess, Iterator{
 34 | 
 35 |     public $first;
 36 |     public $rest;
 37 |     public $length = Null;
 38 |     public $iterator_key = 0;
 39 |     public $iterator_el;
 40 |     public $arr;
 41 |     public $delimiter_tokens = array("OpenParenToken", "CloseParenToken");
 42 | 
 43 |     public static function create_from_array($xs, $cls="PharenCachedList"){
 44 |         if(empty($xs)){
 45 |             return new PharenEmptyList;
 46 |         }
 47 |         $cache = SplFixedArray::fromArray($xs);
 48 |         $reversed = array_reverse($xs, True);
 49 |         $last_el = array_shift($reversed);
 50 |         $len = count($xs);
 51 |         $el1 = new $cls($last_el, new PharenEmptyList, 1, $cache, $len-1);
 52 |         foreach($reversed as $i=>$x){
 53 |             $index = $len-($i+2);
 54 |             $el2 = $el1->cached_cons($x, $cache, $index, $cls);
 55 |             $el1 = $el2;
 56 |         }
 57 |         return $el1;
 58 |     }
 59 | 
 60 |     public static function seqify(&$xs){
 61 |         if(is_array($xs)){
 62 |             if(count($xs) === 0){
 63 |                 return new PharenEmptyList;
 64 |             }else{
 65 |                 return self::create_from_array($xs);
 66 |             }
 67 |         }else if($xs instanceof PharenHashMap) {
 68 |             $arr = array();
 69 |             foreach($xs as $key=>$val){
 70 |                 $arr []= array($key, $val);
 71 |             }
 72 |             return self::create_from_array($arr);
 73 |         }else if(is_string($xs)){
 74 |             $splitted = str_split($xs);
 75 |             return self::create_from_array($splitted);
 76 |         }
 77 |     }
 78 | 
 79 |     public function __construct($first, $rest=null, $length=1){
 80 |         $this->first = $first;
 81 |         $this->rest = $rest;
 82 |         $this->length = $length;
 83 |         $this->iterator_el = $this;
 84 |     }
 85 | 
 86 |     public function __toString(){
 87 |         $vals = array();
 88 |         foreach($this as $val){
 89 |             if(is_object($val)){
 90 |                 $vals []= $val->__toString();
 91 |             }else if(is_array($val)){
 92 |                 $vals []= "[".implode(", ", $val)."]";
 93 |             }else{
 94 |                 if(is_string($val)){
 95 |                     $val = '"'.$val.'"';
 96 |                 }
 97 |                 $vals []= $val;
 98 |             }
 99 |         }
100 |         return "[" . implode(", ", $vals) . "]";
101 |     }
102 | 
103 |     public function seq(){
104 |         return $this;
105 |     }
106 | 
107 |     public function eq($other){
108 |         if($other instanceof IPharenSeq || is_array($other)){
109 |             foreach($this as $index=>$thisval){
110 |                 if(!isset($other[$index]) || !eq($thisval, $other[$index])){
111 |                     return False;
112 |                 }
113 |             }
114 |             if(isset($index) && isset($other[$index+1])){
115 |                 return False;
116 |             }
117 |             return True;
118 |         }else{
119 |             return $this === $other;
120 |         }
121 |     }
122 | 
123 |     public function arr(){
124 |         if($this->arr)
125 |             return $this->arr;
126 | 
127 |         $arr = array();
128 |         foreach($this as $val){
129 |             $arr[] = $val;
130 |         }
131 |         $this->arr = $arr;
132 |         return $arr;
133 |     }
134 | 
135 |     public function count(){
136 |         if(isset($this->length)){
137 |             return $this->length;
138 |         }else{
139 |             $this->length = 1 + $this->rest()->count();
140 |             return $this->length;
141 |         }
142 |     }
143 | 
144 |     public function offsetExists($offset){
145 |         $list = $this;
146 |         for($x=$offset; $x > 0 && $list !== Null; $x--){
147 |             $list = $list->rest;
148 |         }
149 |         return $list !== Null;
150 |     }
151 | 
152 |     public function offsetGet($offset){
153 |         $list = $this;
154 |         for($x=$offset; $x > 0; $x--){
155 |             if($list instanceof PharenEmptyList){
156 |                 throw new OutOfRangeException;
157 |             }
158 |             $list = $list->rest;
159 |         }
160 |         return $list->first;
161 |     }
162 | 
163 |     public function offsetSet($offset, $value){
164 |     }
165 | 
166 |     public function offsetUnset($offset){
167 |     }
168 | 
169 |     public function current(){
170 |         return $this->iterator_el->first;
171 |     }
172 | 
173 |     public function key(){
174 |         return $this->iterator_key;
175 |     }
176 | 
177 |     public function next(){
178 |         $this->iterator_key++;
179 |         $this->iterator_el = $this->iterator_el->rest;
180 |     }
181 | 
182 |     public function rewind(){
183 |         $this->iterator_key = 0;
184 |         $this->iterator_el = $this;
185 |     }
186 | 
187 |     public function valid(){
188 |         return $this->iterator_el->length !== 0;
189 |     }
190 | 
191 |     public function first(){
192 |         return $this->first;
193 |     }
194 | 
195 |     public function rest(){
196 |         return $this->rest;
197 |     }
198 | 
199 |     public function cons($value){
200 |         return new PharenList($value, $this, $this->length+1);
201 |     }
202 | 
203 |     public function cached_cons($value, $cached_array, $index, $cls="PharenCachedList"){
204 |         return new $cls($value, $this, $this->length+1, $cached_array, $index);
205 |     }
206 | }
207 | 
208 | class PharenCachedList extends PharenList{
209 |     public $cached_array;
210 |     public $index;
211 | 
212 |     public function __construct($value, $rest, $length, $cached_array, $index){
213 |         parent::__construct($value, $rest, $length);
214 |         $this->cached_array = $cached_array;
215 |         $this->index = $index;
216 |         $this->length = count($this->cached_array) - $index;
217 |     }
218 | 
219 |     public function count(){
220 |         return $this->length;
221 |     }
222 | 
223 |     public function arr(){
224 |         if($this->arr)
225 |             return $this->arr;
226 |         $this->arr = array_slice($this->cached_array->toArray(), $this->index);
227 |         return $this->arr;
228 |     }
229 | 
230 |     public function offsetExists($offset){
231 |         return isset($this->cached_array[$this->index + $offset]);
232 |     }
233 | 
234 |     public function offsetGet($offset){
235 |         return $this->cached_array[$this->index + $offset];
236 |     }
237 | 
238 |     public function offsetSet($offset, $value){
239 |         $this->cached_array[$this->index+$offset] = $value;
240 |     }
241 | 
242 |     public function flatten($delimeters=Null){
243 |         if(is_null($delimeters)){
244 |             $tokens = array();
245 |         }else{
246 |             $tokens = array($delimeters[0]);
247 |         }
248 |         foreach($this->cached_array as $el){
249 |             if($el instanceof PharenCachedList){
250 |                 $tokens = array_merge($tokens, $el->flatten($el->delimiter_tokens));
251 |             }else{
252 |                 $tokens[] = $el;
253 |             }
254 |         }
255 |         if(!is_null($delimeters)){
256 |             $tokens[] = $delimeters[1];
257 |         }
258 |         return $tokens;
259 |     }
260 | }
261 | 
262 | class PharenEmptyList extends PharenList{
263 | 
264 |     public function __construct(){
265 |         $this->first = Null;
266 |         $this->length = 0;
267 |         $this->rest = $this;
268 |     }
269 | }
270 | 
271 | class PharenLazyList implements IPharenSeq, IPharenLazy, ArrayAccess, Iterator{
272 |     public $first = Null;
273 |     public $rest = Null;
274 |     public $length = Null;
275 |     public $lambda;
276 |     public $lambda_result = Null;
277 | 
278 |     public function __construct($lambda){
279 |         $this->lambda = $lambda;
280 |     }
281 | 
282 |     public function __toString(){
283 |         return "<".__CLASS__.">";
284 |     }
285 | 
286 |     public function seq(){
287 |         $this->force();
288 |         return $this->lambda_result;
289 |     }
290 | 
291 |     public function current(){
292 |         $this->iterator_el->force();
293 |         return $this->iterator_el->first;
294 |     }
295 | 
296 |     public function key(){
297 |         return $this->iterator_key;
298 |     }
299 | 
300 |     public function next(){
301 |         $this->iterator_key++;
302 |         $this->iterator_el->force();
303 |         $this->iterator_el = $this->iterator_el->rest;
304 |     }
305 | 
306 |     public function rewind(){
307 |         $this->iterator_key = 0;
308 |         $this->iterator_el = $this;
309 |     }
310 | 
311 |     public function valid(){
312 |         $this->iterator_el->force();
313 |         return !($this->iterator_el->lambda_result instanceof PharenEmptyList);
314 |     }
315 | 
316 |     public function first(){
317 |         $this->force();
318 |         return $this->first;
319 |     }
320 | 
321 |     public function rest(){
322 |         $this->force();
323 |         return $this->rest;
324 |     }
325 | 
326 |     public function offsetExists($offset){
327 |         $list = $this->seq();
328 |         for($x=$offset; $x > 0 && $list !== Null; $x--){
329 |             $list = $list->rest->seq();
330 |         }
331 |         return !($list->seq() instanceof PharenEmptyList);
332 |     }
333 | 
334 |     public function offsetGet($offset){
335 |         $list = $this->seq();
336 |         for($x=$offset; $x > 0; $x--){
337 |             $list = $list->rest->seq();
338 |             if($list instanceof PharenEmptyList){
339 |                 throw new OutOfRangeException;
340 |             }
341 |         }
342 |         return $list->first;
343 |     }
344 | 
345 |     public function offsetSet($offset, $value){
346 |     }
347 | 
348 |     public function offsetUnset($offset){
349 |     }
350 | 
351 |     public function force(){
352 |         if(!$this->lambda_result){
353 |             $lambda = $this->lambda;
354 |             $result = $lambda();
355 | 
356 |             if(empty($result)){
357 |                 $result = new PharenEmptyList;
358 |             }
359 |             $this->lambda_result = $result;
360 |             $this->first = $result->first();
361 |             $this->rest = $result->rest();
362 |         }
363 |     }
364 | 
365 |     public function realized(){
366 |         return $this->lambda_result !== Null;
367 |     }
368 | 
369 |     public function count(){
370 |         if($this->length){
371 |             return $this->length;
372 |         }else{
373 |             $this->length = 1 + $this->rest()->count();
374 |             return $this->length;
375 |         }
376 |     }
377 | 
378 |     public function cons($value){
379 |         return new PharenList($value, $this, Null);
380 |     }
381 | }
382 | 
383 | class PharenDelay implements IPharenLazy{
384 |     public $lambda;
385 |     public $value = Null;
386 |     public $realized = False;
387 | 
388 |     public function __toString(){
389 |         return "<".__CLASS__.">";
390 |     }
391 | 
392 |     public function __construct($lambda){
393 |         $this->lambda = $lambda;
394 |     }
395 | 
396 |     public function force(){
397 |         if(!$this->realized){
398 |             $fn = $this->lambda;
399 |             if(is_array($fn)){
400 |                 $this->value = $fn[0]($fn[1]);
401 |             }else{
402 |                 $this->value = $fn();
403 |             }
404 |             $this->realized = True;
405 |             return $this->value;
406 |         }else{
407 |             return $this->value;
408 |         }
409 |     }
410 | 
411 |     public function realized(){
412 |         return $this->realized;
413 |     }
414 | }
415 | 
416 | class PharenHashMap implements Countable, ArrayAccess, Iterator, IPharenComparable{
417 |     public $hashmap;
418 |     public $count;
419 |     public $delimiter_tokens = array("OpenBraceToken", "CloseBraceToken");
420 | 
421 |     public function __construct($hashmap, $count=Null){
422 |         $this->hashmap = $hashmap;
423 |         if($count){
424 |             $this->count = $count;
425 |         }else{
426 |             $this->count = count($hashmap);
427 |         }
428 |     }
429 | 
430 |     public function __toString(){
431 |         $pairs = array();
432 |         foreach($this as $k=>$v){
433 |             if(is_string($k)){
434 |                 $k = '"'.$k.'"';
435 |             }
436 |             if(is_string ($v)){
437 |                 $v = '"'.$v.'"';
438 |             }
439 |             $pairs []= "$k $v";
440 |         }
441 |         return "{".implode(", ", $pairs)."}";
442 |     }
443 | 
444 |     public function __invoke($key, $default=Null){
445 |         if(isset($this->hashmap[$key])){
446 |             return $this->hashmap[$key];
447 |         }else{
448 |             return $default;
449 |         }
450 |     }
451 | 
452 |     public function arr(){
453 |         return $this->hashmap;
454 |     }
455 | 
456 |     public function hashOf($key){
457 |         if(is_object($key)){
458 |             if($key instanceof IPharenHashable){
459 |                 return $key->hash();
460 |             }else{
461 |                 return spl_object_hash($key);
462 |             }
463 |         }else{
464 |             return $key;
465 |         }
466 |     }
467 | 
468 |     public function assoc($key, $val){
469 |         $new_hashmap = $this->hashmap;
470 |         $key = $this->hashOf($key);
471 |         $new_hashmap[$key] = $val;
472 |         return new PharenHashMap($new_hashmap, $this->count+1);
473 |     }
474 | 
475 |     public function offsetGet($key){
476 |         $key = $this->hashOf($key);
477 |         return $this->hashmap[$key];
478 |     }
479 | 
480 |     public function offsetSet($key, $val){
481 |         $key = $this->hashOf($key);
482 |         $this->hashmap[$key] = $val;
483 |     }
484 | 
485 |     public function offsetUnset($key){
486 |     }
487 | 
488 |     public function offsetExists($key){
489 |         $key = $this->hashOf($key);
490 |         return isset($this->hashmap[$key]);
491 |     }
492 | 
493 |     public function count(){
494 |         return $this->count;
495 |     }
496 | 
497 |     public function current(){
498 |         return current($this->hashmap);
499 |     }
500 | 
501 |     public function key(){
502 |         return key($this->hashmap);
503 |     }
504 | 
505 |     public function next(){
506 |         return next($this->hashmap);
507 |     }
508 | 
509 |     public function rewind(){
510 |         return reset($this->hashmap);
511 |     }
512 | 
513 |     public function valid(){
514 |         if($this->hashmap instanceof SplObjectStorage){
515 |             return $this->hashmap->valid();
516 |         }else{
517 |             return isset($this->hashmap[key($this->hashmap)]);
518 |         }
519 |     }
520 | 
521 |     public function eq($other){
522 |         if($other instanceof PharenHashMap){
523 |             return $this->hashmap == $other->hashmap;
524 |         }else if(is_array($other)){
525 |             return $this->hashmap == $other;
526 |         }else{
527 |             return $this === $other;
528 |         }
529 |     }
530 | }
531 | 
532 | class PharenVector extends PharenCachedList{
533 |     public $delimiter_tokens = array("OpenBracketToken", "CloseBracketToken");
534 | 
535 |     public static function create_from_array($array, $cls="PharenVector"){
536 |         return PharenList::create_from_array($array, __CLASS__);
537 |     }
538 | 
539 |     public function __invoke($n){
540 |         return $this->offsetGet($n);
541 |     }
542 | }
543 | 
544 | class PharenLambda{
545 |     public $closure_id;
546 |     public $func;
547 | 
548 |     public function __construct($func, $closure_id){
549 |         $this->func = $func;
550 |         $this->closure_id = $closure_id;
551 |     }
552 | 
553 |     public function __invoke(){
554 |         $args = func_get_args();
555 |         array_push($args, $this->closure_id);
556 |         return call_user_func_array($this->func, $args);
557 |     }
558 | 
559 |     public function __toString(){
560 |         return "<Lambda: {$this->func}:{$this->closure_id}>";
561 |     }
562 | }
563 | 


--------------------------------------------------------------------------------
/phakefile:
--------------------------------------------------------------------------------
 1 | (use pharen.phake as phake)
 2 | (use pharen.repl as repl)
 3 | 
 4 | (phake.proj "Pharen"
 5 |     {"description" "Lisp -> PHP Compiler"
 6 |      "version" "0.1.5"})
 7 | 
 8 | (task "build" "Compiling all project files written in Pharen"
 9 |       (phake.compile-dir
10 |         (phake.project-path "/lib/pharen")
11 |         (phake.compile-except [(phake.project-path "/lib/phake/phake.phn")])))
12 | 
13 | (task "test" "Running tests for Pharen compiler"
14 |       (compile-file (phake.project-path "/test/pharen_tests.phn"))
15 |       (require (phake.project-path "/test/pharen_tests.php"))
16 |       TRUE)
17 | 


--------------------------------------------------------------------------------
/readme.markdown:
--------------------------------------------------------------------------------
 1 | Pharen is compiler project that compiles a Lisp-inspired language to PHP.
 2 | 
 3 | It is still under development, but small-scale use is definitely possible.
 4 | 
 5 | All documentation for Pharen is at http://scriptor.github.com/pharen.
 6 | 
 7 | [Getting set up](http://scriptor.github.com/pharen/download.html)
 8 | 
 9 | [Reference](http://scriptor.github.com/pharen/reference.html)
10 | 
11 | [Quick and dirty tutorial](http://scriptor.github.com/pharen/tutorial.html)
12 | 
13 | Status
14 | ======
15 | As of now Pharen covers most of what you could do with PHP. Tail recursion is transformed
16 | into reasonably efficient looping, OOP support allows for easily working with existing
17 | PHP libraries, and macros provide a ton more opportunities.
18 | 
19 | If you have any questions, feel free to message me on Github, email me at tamreen.khan@gmail.com,
20 | or drop by the IRC channel at #pharen on irc.freenode.net.
21 | 
22 | If you'd like to contribute, check out the [contribute](http://scriptor.github.com/pharen/contribute.html)
23 | page on the docs site.
24 | 
25 | Compatible with PHP 5.5.
26 | 


--------------------------------------------------------------------------------
/template_debug.php:
--------------------------------------------------------------------------------
 1 | <?php
 2 | namespace pharen\debug;
 3 | 
 4 | if(!function_exists("pharen\\debug\\convert_line_num")){
 5 |     function convert_line_num($line_map, $errline){
 6 |         $pharen_line = 1;
 7 |         foreach($line_map as $php_line=>$ph_line){
 8 |             if($php_line > $errline){
 9 |                 break;
10 |             }
11 |             $pharen_line = $ph_line;
12 |         }
13 |         return $pharen_line;
14 |     }
15 | }
16 | 
17 | if(!function_exists("pharen\\debug\\generate_pharen_err")){
18 |     function generate_pharen_err($msg, $file, $line, $php_line){
19 |         echo "Error: $msg near $file:$line\n";
20 |         return True;
21 |     }
22 | }
23 | 
24 | if(!function_exists("pharen\\debug\\error_handler")){
25 |     function error_handler($errno, $errstr, $errfile, $errline, $errctx){
26 |         $line_map = get_line_map($errfile);
27 |         $pharen_file = basename($errfile, ".php").".phn";
28 |         $pharen_line = convert_line_num($line_map, $errline);
29 |         return generate_pharen_err($errstr, $pharen_file, $pharen_line, $errfile, $errline);
30 |     }
31 | }
32 | 
33 | if(!function_exists("pharen\\debug\\get_line_map")){
34 |     function get_line_map($file){
35 |         $dir = dirname($file);
36 |         $base = basename($file, ".php");
37 |         return include($dir."/".$base.".linemap.php");
38 |     }
39 | }
40 | 
41 | set_error_handler('pharen\debug\error_handler');
42 | 


--------------------------------------------------------------------------------
/test/pharen_tests.phn:
--------------------------------------------------------------------------------
 1 | (require "test.php")
 2 | (use pharen.path as path)
 3 | (use pharen.test as test)
 4 | (define "TESTS_DIR" (dirname __FILE__))
 5 | (require-once (path.join TESTS-DIR "../" "pharen.php"))
 6 | (compile-lang)
 7 | 
 8 | (fn run-test (fname)
 9 |   (print (. "Running test: " fname "\n"))
10 |   (compile-file (. TESTS-DIR "/tests/" fname ".phn") (. TESTS-DIR "/tmp"))
11 |   (require (. TESTS-DIR "/tmp/" fname ".php")))
12 |     
13 | (set-error-handler (lambda (errno errstr file line)
14 |                            (throw (new ErrorException errstr errno 0 file line))
15 |                            TRUE))
16 | 
17 | (fn check (expr expected) (test.check expr expected 1))
18 | 
19 | (let [tests 
20 |       ["literals",
21 |        "func_calls",
22 |        "comments",
23 |        "bindings",
24 |        "lists_and_dicts",
25 |        "cond",
26 |        "if",
27 |        "function_definition",
28 |        "lambdas",
29 |        "plambda",
30 |        "macros",
31 |        "multi",
32 |        "oop"
33 |        "lazy"
34 |        "ns",
35 |        "lang_functions",
36 |        "php_interop",
37 |        "types"
38 |        ]]
39 | 
40 | 
41 |   (test.describe "Pharen"
42 |       (lambda ()
43 |           (map #run-test tests))))
44 | 


--------------------------------------------------------------------------------
/test/tests/bindings.phn:
--------------------------------------------------------------------------------
 1 | (def name "Arthur Dent")
 2 | (check name "Arthur Dent")
 3 | 
 4 | (local job "Jedi Masta")
 5 | (check job "Jedi Masta")
 6 | 
 7 | (let
 8 |   [question NULL
 9 |    answer (* 6 9)]
10 | 
11 |   (check question NULL)
12 |   (check answer 54))
13 | 


--------------------------------------------------------------------------------
/test/tests/comments.phn:
--------------------------------------------------------------------------------
1 | ;Before expression
2 | (check 1 1)
3 | 
4 | (check 1 1) ; End of expression
5 | 
6 | (check 1 ; Middle of expression
7 |      1)
8 | 


--------------------------------------------------------------------------------
/test/tests/cond.phn:
--------------------------------------------------------------------------------
 1 | (def num 3)
 2 | (cond
 3 |     ((== num 1) (fail))
 4 |     ((== num 2) (fail))
 5 |     ((== num 3) (check TRUE TRUE))
 6 |     (TRUE (fail)))
 7 | 
 8 | (def s "Hello, world!")
 9 | (check
10 |   (cond
11 |     ((== s "!dlrow, olleH") "That's backwards!")
12 |     ((== s "Hello, world!") (. "Creative" " much?") "Who is world anyway?"))
13 |   "Who is world anyway?")
14 | 
15 | (def foo
16 |   (cond
17 |     ((== 1 1) "chicken")
18 |     ((== 1 2) "math broke again!")))
19 | (check foo "chicken")
20 | 


--------------------------------------------------------------------------------
/test/tests/func_calls.phn:
--------------------------------------------------------------------------------
 1 | (check (substr "abc" 1) "bc")
 2 | 
 3 | (check (+ 1 2 3.1) 6.1)
 4 | 
 5 | (check (. "hello, " "world") "hello, world")
 6 | 
 7 | (check (substr (. "foo" "bar") 3) "bar")
 8 | 
 9 | (check ((. "sub" "str") "abc" 1) "bc")
10 | 
11 | (local foo "substr")
12 | (check ($foo "abc" 1) "bc")
13 | 


--------------------------------------------------------------------------------
/test/tests/function_definition.phn:
--------------------------------------------------------------------------------
 1 | (fn one-expr ()
 2 |   1)
 3 | (check (one-expr) 1)
 4 | 
 5 | (fn one-arg (a)
 6 |     (. "Argument is " a))
 7 | (check (one-arg "this") "Argument is this")
 8 | 
 9 | (fn add-two-args (a b)
10 |     (+ a b))
11 | (check (add-two-args 133 123) 256)
12 | 
13 | (fn two-exprs (a b)
14 |     (one-arg a)
15 |     (one-arg b))
16 | (check (two-exprs "that" "this") "Argument is this")
17 | 
18 | (fn if-inside (a)
19 |     (if a
20 |         "foo"
21 |         "bar"))
22 | (check (if-inside FALSE) "bar")
23 | 
24 | (fn default-val-arg (a [b "bar"])
25 |   b)
26 | (check (default-val-arg NULL) "bar")
27 | (check (default-val-arg NULL "foo") "foo")
28 | 
29 | (fn fact (n)
30 |   (if (== n 0)
31 |     1
32 |     (* n (fact (- n 1)))))
33 | (check (fact 5) 120)
34 | 
35 | (fn iterative-fact (n acc)
36 |     (if (== n 0)
37 |         acc
38 |         (iterative-fact (- n 1) (* acc n))))
39 | (check (iterative-fact 5 1) 120)
40 | 
41 | (fn splat-usage (a &others)
42 |   (array-sum (arr others)))
43 | (check (splat-usage 1 2 3) 5)
44 | 
45 | (fn nested-func-test ()
46 |   (def foo "world")
47 |   (fn nested-func ()
48 |     (. "hello " foo)
49 |   (check (nested-func) "hello world"))
50 | 


--------------------------------------------------------------------------------
/test/tests/if.phn:
--------------------------------------------------------------------------------
 1 | (def bool TRUE)
 2 | (if bool
 3 |     (check TRUE TRUE)
 4 |     (check TRUE FALSE))
 5 | 
 6 | (check (if TRUE
 7 |          (. "This " "works")
 8 |          (. "Doesn't" "work"))
 9 |        "This works")
10 | 
11 | (check (if FALSE
12 |          (. "Doesn't" "work")
13 |          (. "This " "works"))
14 |        "This works")
15 | 
16 | (def result
17 |     (if TRUE
18 |         (def value "True after all")
19 |         (def value "Shouldn't be here")))
20 | (check result "True after all")
21 | 
22 | (check (if TRUE
23 |          (do
24 |            "Working"
25 |            "Done!")
26 |          "Not working")
27 |        "Done!")
28 | 


--------------------------------------------------------------------------------
/test/tests/lambdas.phn:
--------------------------------------------------------------------------------
 1 | (check (arr (map (lambda (n) (* n 2))
 2 |                  [1 2 3]))
 3 |        [2 4 6])
 4 | 
 5 | (fn apply-test (f n)
 6 |   ($f n))
 7 | (check (apply-test (lambda (n)
 8 |                            (. n " bar")) "foo") "foo bar")
 9 | 
10 | (fn greet-generator-test (s)
11 |   "line1"
12 |   (lambda () (. "Hello " s "!")))
13 | (check ((greet-generator-test "Hammurabi")) "Hello Hammurabi!")
14 | 
15 | (fn multi-lambdas ()
16 |   (lambda unused () "")
17 |   (lambda used () "foo"))
18 | (check ((multi-lambdas)) "foo")
19 | 
20 | (fn multiple-calls-test ()
21 |   (lambda () "foobar"))
22 | (multiple-calls-test)
23 | (multiple-calls-test)
24 | (check ((multiple-calls-test)) "foobar")
25 | 


--------------------------------------------------------------------------------
/test/tests/lang_functions.phn:
--------------------------------------------------------------------------------
  1 | ;here test coverage of lang.phn
  2 | 
  3 | 
  4 | (check (when (== 1 1) (= x 2)) 2)
  5 | 
  6 | (check (not (== 2 2)) FALSE)
  7 | 
  8 | (check (pharen-or (== 3 1) (== 1 2)) FALSE)
  9 | (check (pharen-or (== 1 1) (== 1 2)) TRUE)
 10 | 
 11 | (check (pharen-and (== 1 1) (== 1 2)) FALSE)
 12 | (check (pharen-and (== 1 1) (== 2 2)) TRUE)
 13 | 
 14 | (check ((thunk (+ 1 2))) 3)
 15 | 
 16 | 
 17 | (class A  (access public (local name "")))
 18 | (local a (new A))
 19 | (check (inst? a #A) TRUE)
 20 | 
 21 | 
 22 | (check (first [0 1 2]) 0)
 23 | (check (rest [0 1 2]) [1 2])
 24 | (check (pharen-list 1 2 3) [1 2 3])
 25 | (check (last [1 2 3]) 3)
 26 | (check (butlast [1 2 3]) [1 2])
 27 | (check (eq 1 1) TRUE)
 28 | (check (eq 1 2) FALSE)
 29 | (local a1 (new A))
 30 | (check (eq a1 a1) TRUE)
 31 | 
 32 | 
 33 | (check (if-let [x 2] x FALSE) 2)
 34 | (check (when-let [x 2] x) 2)
 35 | (check (if-not (== 1 2) #a #b) #a)
 36 | (check (when-not (== 1 2) #a) #a)
 37 | 
 38 | (let [y 100]
 39 |   (dotimes [x 100] (set! y (+ x 100)) (check y (+ x 100))))
 40 |     
 41 | (check (zero? 0) TRUE)
 42 | (check (zero? 1) FALSE)
 43 | 
 44 | (check (pos? 1) TRUE)
 45 | (check (pos? -1) FALSE)
 46 | 
 47 | (check (neg? -1) TRUE)
 48 | (check (neg? 1) FALSE)
 49 | 
 50 | (check (odd? (/ 100 2)) FALSE)
 51 | (check (even? (/ 100 2)) TRUE)
 52 | 
 53 | (check (str "a" "b") "ab")
 54 | (check (identity 1) 1)
 55 | (check (inc 1) 2)
 56 | (check (dec 2) 1)
 57 | 
 58 | (let [fnx (comp (lambda (x) (+ 1 x)) (lambda (y) (+ 2 y)))]
 59 |   (check ($fnx 1) 4))
 60 | 
 61 | (check (zero-or-empty? 1 []) TRUE)
 62 | (check (zero-or-empty? 0 [1 2]) TRUE)
 63 | (check (empty? []) TRUE)
 64 | (check (empty? [1]) FALSE)
 65 | (check (seq? [1 2 3]) TRUE)
 66 | (check (sequential? [1 2 3]) TRUE)
 67 | (check (seq? (seq [1 2 3])) TRUE)
 68 | (check (: (hashify {#a 1}) #a) 1)
 69 | 
 70 | ;dont pass dont return 1
 71 | ;(check (: (hash-from-pairs "a" 1 ) a) 1)
 72 | 
 73 | 
 74 | (check (arr [1 2 3]) (array 1 2 3))
 75 | (check (second [1 2]) 2)
 76 | 
 77 | ;dont pass
 78 | ;array_slice() expects parameter 1 to be array, object given in /Users/francesco/Documents/github/pharen2/lang.php on line 190
 79 | ;(check (: (first-pair {#a 1 #b 2}) a) 1)
 80 | 
 81 | (check (cons 0 [1 2 3]) [0 1 2 3])
 82 | 
 83 | 
 84 | (check (:(assoc #a 1 {}) #a) 1)
 85 | (check (get #a {#a 1}) 1)
 86 | 
 87 | (check (take 2 [0 1 2]) [0 1])
 88 | (check (drop 2 [0 1 2]) [2])
 89 | (check (reverse [1 2 3]) [3 2 1])
 90 | (check (interpose "-" [1 2 3]) [1 "-" 2 "-" 3])
 91 | (check (partition 3 [1 2 3 4 5 6 7 8 9]) [[1 2 3] [4 5 6] [7 8 9]])
 92 | (check (interleave [1 2 3] [4 3 6]) [1 4 2 3 3 6])
 93 | (check (zip-with (lambda (a b) (+ a b)) [1 2 3] [4 5 6]) [5 7 9])
 94 | (check (seq-join [1 2 3 4 5] ",") "1,2,3,4,5")
 95 | 
 96 | (check (inst? (infinity) #PharenLazyList) TRUE)
 97 | (check (inst? (repeat [1 2 3]) #PharenLazyList) TRUE)
 98 | (check (inst? (repeatedly (lambda (a) (+ a)))  #PharenLazyList) TRUE)
 99 | (check (inst? (iterate (lambda (a) (+ a)) 100)  #PharenLazyList) TRUE)
100 | (check (inst? (cycle [1 2 3])  #PharenLazyList) TRUE)
101 | (check (inst? (cycle-with (+ 1) [1 2 3])  #PharenLazyList) TRUE)
102 | 
103 | (check (vals [1 2 3]) [1 2 3])
104 | ;fails
105 | ;(check (append 4 [1 2 3]) [1 2 3 4])
106 | (check (apply (lambda (a b) (+ a b)) 1 2) 3)
107 | (check (apply (flip (lambda (a b) [a b])) 1 2) [2 1])
108 | (check (apply (juxt (+ 1) (+ 2)) 1) [2 3])
109 | (check (concat [1] [2]) [1 2])
110 | (check (into [3] [1 2 3 4 5]) [5, 4, 3, 2, 1, 3])
111 | (check (reduce (+ 1) 0 [1 2 3 4 5]) 6)
112 | ;(check  (reduce (+ 1) 10 [1 2 3 4 5]) 16)  fails
113 | ;(check  (reduce (lambda (x) (+ x 1)) 10 [1 2 3 4 5]) 16)  fails
114 | ;(print (reduce-fns [(+ 1)] 0 [1 2 3])) is correct this?
115 |   
116 | (check (reduce-to-str (+ 1) [1 2 3]) "234")
117 | 
118 | ;(print-r (reduce-pairs (lambda (k v) k) 0 [1 2 3] )) this return an array. how function this?
119 |   
120 | (check (map (+ 1) [1 2 3]) [2 3 4])  
121 | ;(check (filter (> 4) [1 2 3 4 5 6]) [4 5 6]) dont pass return [1 2 3] should return [4 5 6] acts like a reject
122 |   
123 | ;(print (map-pairs (lambda (k v) v) [[#a 1] [#b 2]])) also this i dont know of call correctly
124 | ; samo for map-indexed  
125 | 


--------------------------------------------------------------------------------
/test/tests/lazy.phn:
--------------------------------------------------------------------------------
 1 | (ns lazy-tests)
 2 | (use pharen.lazy as lazy)
 3 | 
 4 | (check (lazy.map (* 2) [1 2 3]) [2 4 6])
 5 | 
 6 | (check (lazy.take 3 (infinity)) [0 1 2])
 7 | 
 8 | (check (lazy.interleave [1 2 3] [4 5 6]) [1 4 2 5 3 6])
 9 | 
10 | (check (lazy.filter #pos? [1 -2 3 -5]) [1 3])
11 | 
12 | (check (take 5 (infinity)) [0 1 2 3 4])
13 | 
14 | (check (take 3 (cycle [1 2])) [1 2 1])
15 | 


--------------------------------------------------------------------------------
/test/tests/lists_and_dicts.phn:
--------------------------------------------------------------------------------
 1 | (check (count [1 2 3]) 3)
 2 | (check [1 .. 5] [1 2 3 4 5])
 3 | (check [1 3 .. 6] [1 3 5])
 4 | 
 5 | (check (:["pharen" "php"] 0) "pharen")
 6 | (check (["pharen" "php"] 0) "pharen")
 7 | 
 8 | (def lst ["scheme" "CL" "clojure"])
 9 | (check (:lst 2) "clojure")
10 | (check ($lst 2) "clojure")
11 | 
12 | (check (count {"functional" "Haskell",
13 |                "imperative" "C",
14 |                "wtf" "Pharen"}) 3)
15 | 
16 | (check (:{"functional" "Haskell",
17 |           "imperative" "C",
18 |           "wtf" "Pharen"} "wtf") "Pharen")
19 | 
20 | (def dct {"functional" "Haskell",
21 |           "imperative" "C",
22 |           "wtf" "Pharen"})
23 | (check (:dct "functional") "Haskell")
24 | 
25 | (def new-dct (assoc "logic" "Prolog" dct))
26 | (check (:new-dct "logic") "Prolog")
27 | 
28 | (check ({"foo" "bar"} "foo") "bar")
29 | (check ($dct "imperative") "C")
30 | 


--------------------------------------------------------------------------------
/test/tests/literals.phn:
--------------------------------------------------------------------------------
1 | (check 8 (* 4 2))
2 | (check "abc" (. "a" "bc"))
3 | (check TRUE TRUE)
4 | (check [1 2 3] [1 2 3])
5 | (check ["list" "of" "strings"] ["list" "of" "strings"])
6 | (check {1 2 "foo" "bar"} {"foo" "bar" 1 2})
7 | (check #strstr "\\strstr")
8 | (check #foo-bar-baz "\\foo_bar_baz")
9 | 


--------------------------------------------------------------------------------
/test/tests/macros.phn:
--------------------------------------------------------------------------------
 1 | (defmacro simple-macro-test (n)
 2 |   (if (< n 10)
 3 |     '(* ~n ~n)
 4 |     '(. ~n " is too big!")))
 5 | (check (simple-macro-test 5) 25)
 6 | (check (simple-macro-test 15) "15 is too big!")
 7 | 
 8 | (defmacro nested-leaf-test (l)
 9 |   (def n (:l 1))
10 |   n)
11 | (check (nested-leaf-test (foo 1)) 1)
12 | 
13 | (defmacro fn-generator-test (nm value)
14 |   '(fn ~-nm ()
15 |      (def stuff "foo")
16 |      (. stuff ~value)))
17 | (fn-generator-test "generated_test_fn" "bar")
18 | (check (generated-test-fn) "foobar")
19 | 
20 | (defmacro when-test (c &body)
21 |   '(if ~c
22 |      (do
23 |        ~@body)
24 |      FALSE))
25 | (check (when-test (== 2 2)
26 |                   (. "line" 1)
27 |                   "foobar") "foobar")
28 | 
29 | (defmacro var-in-macro (name val)
30 |   (def nm name)
31 |   '(fn ~name ()
32 |      (let [~nm ~val]
33 |        ~nm)))
34 | 
35 | (var-in-macro var-test "foo")
36 | (check (var-test) "foo")
37 | 


--------------------------------------------------------------------------------
/test/tests/multi.phn:
--------------------------------------------------------------------------------
1 | (defmulti multi-tst (n))
2 | (defmethod multi-tst ["int"] (n)
3 |   "int")
4 | (defmethod multi-tst ["str"] (n)
5 |   "string")
6 | 
7 | (check (multi-tst 2) "int")
8 | (check (multi-tst "foo") "string")
9 | 


--------------------------------------------------------------------------------
/test/tests/ns.phn:
--------------------------------------------------------------------------------
 1 | (ns foo)
 2 | (fn test ()
 3 |   42)
 4 | 
 5 | (ns foo.bar)
 6 | (fn test ()
 7 |   100)
 8 | 
 9 | (ns bar)
10 | (fn test ()
11 |   7)
12 | (use foo)
13 | (check (foo.test) 42)
14 | (check (test) 7)
15 | 
16 | (ns baz)
17 | (use foo as f)
18 | (use foo.bar as fb)
19 | (check (f.test) 42)
20 | (check (fb.test) 100)
21 | 


--------------------------------------------------------------------------------
/test/tests/oop.phn:
--------------------------------------------------------------------------------
 1 | (class User
 2 |        (access public (local name ""))
 3 |        (attr last-name "")
 4 | 
 5 |        (access public
 6 |                (fn __construct (name last-name)
 7 |                  (def (-> this name) name)
 8 |                  (def (this last-name) last-name)))
 9 | 
10 |        (access public (fn get-name ()
11 |          (-> this name)))
12 |        
13 |        (method get-last-name ()
14 |                (this last-name)))
15 | 
16 | (local my-obj (new User "Julius" "Caesar"))
17 | (check (-> my-obj (get-name)) "Julius")
18 | (check -> my-obj (get-last-name)
19 | 


--------------------------------------------------------------------------------
/test/tests/php_interop.phn:
--------------------------------------------------------------------------------
 1 | ;check array interoperation
 2 | (check (array-map (+ 1) (arr [1 2 3])) (array 2 3 4))
 3 | (check (array-map (lambda (x) (+ x 1)) (arr [1 2 3])) (array 2 3 4))
 4 | 
 5 | ;???array filter in php act like a reject??????
 6 | (check (array-filter (arr [1 2 3 4 5 6 7 8 9 10]) (> 4)) (array 1 2 3))
 7 | (check (array-filter (arr [1 2 3 4 5 6 7 8 9 10]) (lambda (x) (> 4 x))) (array 1 2 3))
 8 | 
 9 | (check (== (array 1 2 3) (array 1 2 3)) TRUE)
10 | (check (eq (array 1 2 3) (array 1 2 3)) TRUE)
11 | (check (eq [1 2 3] [1 2 3])  TRUE)
12 | (check (eq [1 2 3] (array 1 2 3))  TRUE)
13 | (check (== [1 2 3] (array 1 2 3))  FALSE)
14 | 
15 | ;interoperation with associative array in php isnt clare for now.
16 | ;(print (array-keys (hashify {#a 1 #b 2})))
17 | 
18 | ;check lambda and closure interaction
19 | (let [sum 100]
20 |   (check (array-map (lambda (x) (+ x sum)) (arr [1 2 3])) (array 101 102 103)))
21 |   
22 | (def sum2 101)
23 | (check (array-map (lambda (x) (+ x sum2)) (arr [1 2 3])) (array 102 103 104))
24 | 
25 | 


--------------------------------------------------------------------------------
/test/tests/plambda.phn:
--------------------------------------------------------------------------------
 1 | (def x 100)
 2 | (def y 100)
 3 | (def sum (plambda (a b) (+ a b x y)))
 4 | (def sum3 (plambda (a b) (+ a b)))
 5 | (check ($sum 1 2) 203)
 6 | (check ($sum3 1 2) 3)
 7 | 
 8 | 
 9 | (defmacro gen-sum (n) '(plambda (x) (+ x ~n)))
10 | (def sum10 (gen-sum 10))
11 | (check ($sum10 100) 110)
12 | 
13 | (def summer 100)
14 | (check (array_map (plambda (n) (+ n summer)) (arr [1 2 3 4 5 6])) [101 102 103 104 105 106])
15 | (fn fn-gen-sum (n)  (plambda (x) (+ x n)))
16 | 
17 | (def sum20 (fn-gen-sum 20))
18 | (check ($sum20 30) 50)
19 | 


--------------------------------------------------------------------------------
/test/tests/types.phn:
--------------------------------------------------------------------------------
 1 | (ns pharen.tests.types)
 2 | 
 3 | (fn foo (^int x) ^int
 4 |   x)
 5 | 
 6 | (def x 1)
 7 | (ann x ^int)
 8 | (check (foo x) 1)
 9 | (check (foo (foo x)) 1)
10 | 
11 | (let
12 |   [var1 "var1"
13 |    var2 "var2" ^B
14 |    a 1 ^int
15 |    var3 "var3"
16 |    var4 "var4" ^C]
17 |   (check (foo a) 1))
18 | 
19 | (poly-ann foo (^double x) ^double)
20 | (def y 1.5)
21 | (ann y ^double)
22 | (check (foo y) 1.5)
23 | (check (foo (foo y)) 1.5)
24 | 
25 | (fun foo (^boolean x) ^boolean
26 |      FALSE)
27 | (check (foo TRUE) FALSE)
28 | (check (foo (foo TRUE)) FALSE)
29 | 


--------------------------------------------------------------------------------
/todo.txt:
--------------------------------------------------------------------------------
 1 | Below are a list of tasks that need to be done before Pharen is ready to be released (again).
 2 | 
 3 | 1. PHP 5.4 support
 4 |     x Namely this involves getting rid of strict errors
 5 |         - Resolved for now by ignoring strict errors in php 5.4
 6 |     - Possible support for traits
 7 | 2. More test coverage
 8 |     - Cover all lang.phn functions and macros
 9 |     x Cover new features
10 |         x Namespaces
11 |         x New lambdas
12 |         x Lazy lists
13 |         x Pharen Hashmaps
14 |         x Pharen Vectors
15 |     x Cover more edge cases
16 | 3. Clean up namespaces
17 |     x Namespace all lib files
18 |     ~ Formalize all namespace names and place under Pharen
19 |         - Need to do one more check
20 |     x Fix how funcvals are namespaced
21 |     x Fix that you have to prepend global class names with a dot
22 |         - Issue with PHP itself, not a big deal
23 | 4. Update documentation
24 |     - Rewrite existing text to reflect changes
25 |     - Document new features
26 |     - Change the tutorial to use a better example
27 |         - Talk about REPL-driven development
28 |     - Document all the new lang functions
29 | 5. Fix mutability calls in multimethods
30 | 6. Flesh out PharenVector and PharenHashmap
31 |     - Implement vectors as trees internally?
32 |     - Add any necessary functions for working with hashmaps
33 |         - update-in might be useful
34 | 7. Complete OOP support
35 |     x Abstract classes and interfaces
36 |         x Will allow for more compatibility with other PHP code
37 |     - Class hints?
38 |     - In general, still have to emphasize the functional nature of Pharen
39 | 
40 | 


--------------------------------------------------------------------------------