impc:ir:compile:make-env   scheme


Defined in:  https://github.com/digego/extempore/tree/v0.8.9/runtime/llvmir.xtm

Implementation

(define impc:ir:compile:make-env
  (lambda (ast types)
    ;; (println 'ast: ast 'types types)
    (let* ((os (make-string 0))
           (lambda-envs '())
           (result '())
           (env-zone-tmp '())
           (res
            (map (lambda (p)
                   (set! *impc:ir:sym-name-stack* (cons (caar p) *impc:ir:sym-name-stack*))
                   ;;(println '__envin: *impc:ir:sym-name-stack*)
                   ;; (println 'p2: (cadr p))
                   (let* ((symstr (symbol->string (caar p)))
                          (symtype (cdr (assoc-strcmp (caar p) types)))
                          (value (impc:ir:compiler (cadr p) types symtype))
                          (typestr (cadr (impc:ir:gname)))
                          (e (impc:ir:gname)))
                     ;; (println 'symstr: symstr 'symtype: symtype)
                     ;; (println 'typestr: typestr)
                     (if (and (number? (cadr p)) ;; if numeric constant force to type of symbol
                              (impc:ir:number? (cdr (assoc-strcmp (caar p) types)))
                              (impc:ir:number? (impc:ir:get-type-from-str typestr)))
                         (set! typestr (impc:ir:get-type-str (cdr (assoc-strcmp (caar p) types)))))
                     ;; type check
                     ;; (println 'tt1: (impc:ir:get-type-from-str typestr) 'tt2: (cdr (assoc-strcmp (caar p) types)))
                     (if (not (equal? (impc:ir:get-type-from-str typestr) ;; check to see if the two types are equal?
                                      (cdr (assoc-strcmp (caar p) types))))
                         (impc:compiler:print-type-mismatch-error
                          (impc:ir:pretty-print-type typestr)
                          (impc:ir:pretty-print-type (cdr (assoc-strcmp (caar p) types)))
                          (caar p)))
                                        ;(println 'value: value 'typestr: typestr) ;'cadrp (cadr p))
                                        ;(emit (impc:ir:gname "zone" "%mzone*") " = call %mzone* @llvm_peek_zone_stack()\n" os)
                                        ;(emit "call ccc void @llvm_print_i32(i32 111)\n" os)
                     (emit (impc:ir:gname "tzone" "i8*") " = load i8*, i8** %_impzPtr\n"
                           (impc:ir:gname "zone" "%mzone*") " = bitcast i8* " (car (impc:ir:gname "tzone")) " to %mzone*\n"
                           os)
                     (emit  "\n; let assign value to symbol " symstr "\n" os)
                     ;; (emit "call ccc void @llvm_print_i32(i32 222)\n" os)


Back to Index

Similar Entries