reworked the array-to-ast function

TODO.md

@@ -1,4 +1,6 @@
 # Compiler
+  - Need let polymorphism before array literals can be nested
+  - Better (shorter, using < and >) names for generic functions
   - Automatically implement for structs and arrays:
 	 - copy
 	 - delete

lisp/ast.carp

@@ -33,8 +33,15 @@
 
 (defn nest [a index array-name-symbol]
   (match a
-    [] array-name-symbol
-    [x & xs] (list 'array-set (nest xs (inc index) array-name-symbol) index x)))
+    [] (literal-or-lookup-to-ast array-name-symbol)
+    [x & xs]
+    (do
+      ;;(println (str "nest x & xs: " x " & " xs))
+      (let [array-set-signature (list :fn (list (list :Array (gen-typevar)) :int (gen-typevar)) (list :Array (gen-typevar)))]
+        {:node :app
+         :type (gen-typevar)
+         :head (assoc (literal-or-lookup-to-ast 'array-set) :type array-set-signature)
+         :tail (list (nest xs (inc index) array-name-symbol) (literal-or-lookup-to-ast index) (form-to-ast x))}))))
 
 (def array-to-ast-var-name-counters (copy {}))
 
@@ -42,10 +49,20 @@
   (let [a-count (count a)
         array-name-symbol (symbol (gen-var-name array-to-ast-var-name-counters "array"))
         nested-calls (nest a 0 array-name-symbol)
-        array-setup-ast (form-to-ast (list 'let [array-name-symbol (list 'array-of-size a-count)]
-                                           nested-calls))]
+        ;; array-form (list 'let [array-name-symbol (list 'array-of-size a-count)]
+        ;;                  nested-calls)
+        ;;array-setup-ast (form-to-ast array-form)
+        array-setup-ast {:node :let
+                         :type (gen-typevar)
+                         :bindings (list {:node :binding
+                                          :type (gen-typevar)
+                                          :name array-name-symbol
+                                          :value (form-to-ast (list 'array-of-size a-count))})
+                         :body nested-calls}
+        ]
     (do
-      ;;(println (str "array-setup-ast:\n" array-setup-ast))
+      ;;(println (str "\narray-setup-ast:\n" array-setup-ast))
+      ;;(println (str "\narray-form:\n" array-form))
       array-setup-ast)))
 
 (defn list-to-ast [l]

lisp/infer_types.carp

@@ -58,7 +58,7 @@
                   (concat func-arg-constrs (cons func-ret-constr new-constraints)))
 
       :app (let [ret-constr {:a  (get ast :type) :b (get-in ast '(:head :type 2)) :doc "ret-constr for :app"}
-                 arg-constrs (map2 (fn (a b) {:a a :b b :doc "app-arg"}) (get-in ast '(:head :type 1)) (map :type (:tail ast)))
+                 arg-constrs (map2 (fn (a b) {:a a :b b :doc (str "app-arg " a " vs " b)}) (get-in ast '(:head :type 1)) (map :type (:tail ast)))
                  head-constrs (generate-constraints-internal '() (:head ast) type-env)
                  tail-constrs (reduce (fn (constrs tail-form) (generate-constraints-internal constrs tail-form type-env))
                                       '() (:tail ast))
@@ -280,7 +280,7 @@
                           (do (when log-substs (println "Current binding do not match new value"))
                               (if (or (= :any lhs) (typevar? value-lookup))
                                 substs
-                                (error (str "Can't unify typevar \n" existing " with \n" value-lookup)))))))))))
+                                (error (str "Can't unify typevar \n\n" existing "\n\nwith\n\n" value-lookup "\n\nLocation: " (meta-get value :doc))))))))))))
         ;; Not a typevar:
         (if (list? lhs)
           (let [value-lookup (lookup substs value)]
@@ -312,7 +312,11 @@
 (defn solve-contraint-internal (substs constraint)
   (let [a (:a constraint)
         b (:b constraint)]
-    (solve (solve substs a b) b a))) ; Solving from both directions!
+    (do
+      ;; TODO: set meta earlier in process
+      (meta-set! a :doc (get-maybe constraint :doc))
+      (meta-set! b :doc (get-maybe constraint :doc))
+      (solve (solve substs a b) b a)))) ; Solving from both directions!
 
 ;; Returns a substitution map from type variables to actual types
 (defn solve-constraints (constraints)

out/project.carp

@@ -11,3 +11,29 @@
 ;;(load-gl)
 
 
+;; (defn no-nesting []
+;;   [666])
+
+;;(def ast1 (lambda-to-ast (code no-nesting)))
+;;(def con1 (gencon1))
+
+;; (defn nesting1 []
+;;   [(string-copy "hej")])
+;; (def ast1 (annotate-ast (lambda-to-ast (code nesting1))))
+
+;; (defn nesting2 []
+;;   [3.0 2.0 1.0])
+;; (def ast2 (annotate-ast (lambda-to-ast (code nesting2))))
+
+;; (defn nesting3 []
+;;   [[1000 2000 3000]])
+;; (def ast3 (annotate-ast (lambda-to-ast (code nesting3))))
+
+
+(defn nesting []
+  [[(string-copy "hej")]])
+
+(def ast (lambda-to-ast (code nesting)))
+(def con (gencon ast))
+
+;;(def asta (annotate-ast ast2))

src/eval.c

@@ -995,8 +995,8 @@ void eval_text(Obj *env, char *text, bool print, Obj *filename) {
     if(eval_error) {
       printf("\e[31mERROR: %s\e[0m\n", obj_to_string_not_prn(eval_error)->s);
       function_trace_print();
-      printf("\n\n");
-      stack_print();
+      /* printf("\n"); */
+      /* stack_print(); */
       eval_error = NULL;
       if(LOG_GC_POINTS) {
         printf("Running GC after error occured:\n");

src/repl.c

@@ -59,9 +59,6 @@ void repl(Obj *env) {
     }
     if(paren_balance(input) <= 0) {
       eval_text(env, input, true, obj_new_string("repl"));
-      if(!eval_error && stack_pos != 0) {
-        printf("WARNING: Stack pos should be 0 but is now: %d\n", stack_pos);
-      }
       pop_stacks_to_zero();
       printf("\n");
     }