factor: bugfixes. self hosting works now
authorJordan Lewis <jordan@knewton.com>
Thu, 2 Apr 2015 17:40:15 +0000 (13:40 -0400)
committerJordan Lewis <jordan@knewton.com>
Thu, 2 Apr 2015 18:51:34 +0000 (14:51 -0400)
... except for metadata on collections, which is still unimplemented.

factor/src/core/core.factor
factor/src/malenv/malenv.factor
factor/src/stepA_mal/stepA_mal.factor

index 1913b43..b61695b 100644 (file)
@@ -24,7 +24,7 @@ CONSTANT: ns H{ { "+" [ first2 + ] }
                 { "list?" [ first array? ] }
                 { "empty?" [ first empty? ] }
                 { "count" [ first dup nil? [ drop 0 ] [ length ] if ] }
-                { "=" [ first2 2dup [ [ sequence? ] [ string? not ] bi and ] bi@ and [ sequence= ] [ = ] if ] }
+                { "=" [ first2 2dup [ { [ ] [ sequence? ] [ string? not ] } 1&& ] bi@ and [ sequence= ] [ = ] if ] }
                 { "<" [ first2 < ] }
                 { ">" [ first2 > ] }
                 { ">=" [ first2 >= ] }
index a409fce..dfc80c2 100644 (file)
@@ -12,7 +12,7 @@ TUPLE: malenv
 INSTANCE: malenv assoc
 
 C: <malenv> malenv
-: new-env ( outer -- malenv ) H{ } malenv boa ;
+: new-env ( outer -- malenv ) H{ } clone malenv boa ;
 
 M:: malenv at* ( key assoc -- value/f ? )
     key name>> assoc data>> at*
index 373de58..8149d74 100755 (executable)
@@ -127,23 +127,29 @@ DEFER: EVAL
 : rep ( x -- x ) [ READ repl-env get EVAL PRINT ] [ nip pr-str ] recover ;
 
 : main-loop ( -- )
+            "(println (str \"Mal [\" *host-language* \"]\"))" rep drop
             [ 1 ]
             [ "user> " readline
               [ 0 exit ] unless*
               rep print flush ]
             while ;
 
-: run-or-repl ( -- )
-    command-line get dup empty? [ drop main-loop ] [ first "(load-file \"" "\")" surround rep print flush ] if ;
+: main ( -- )
+    command-line get dup empty?
+    [ drop main-loop ]
+    [ first "(load-file \"" "\")" surround rep print flush ]
+    if ;
 
 f ns <malenv> repl-env set-global
 
+
 [ first repl-env get EVAL ] "eval" repl-env get data>> set-at
-command-line get "*ARGV*" repl-env get data>> set-at
+command-line get dup empty? [ rest ] unless "*ARGV*" repl-env get data>> set-at
 
+"(def! *host-language* \"factor\")" rep drop
 "(def! not (fn* (a) (if a false true)))" rep drop
 "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" rep drop
 "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" rep drop
 "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))" rep drop
 
-MAIN: run-or-repl
+MAIN: main