Mercurial > repos > tabletprog
view modules/array.tp @ 251:2557ce4e671f
Fix a couple of compiler bugs. topenv was getting initialized in multiple places. This resulted in multiple copies of modules getting created which caused problems for macro expansion. Additionally, arguments were not being marked as declared during code generation so assigning to an argument that was not closed over generated invalid C code.
author | Michael Pavone <pavone@retrodev.com> |
---|---|
date | Fri, 11 Apr 2014 22:29:32 -0700 |
parents | fd9005253861 |
children | 56409de95f55 |
line wrap: on
line source
#{ llProperty: size withType: uint32_t llProperty: storage withType: uint32_t llProperty: data withType: ((object ptr) ptr) llMessage: get withVars: { index <- obj_int32 ptr } andCode: :index { if: (index num) >= 0 && (index num) < size { (self data) get: (index num) } else: { false } } llMessage: set withVars: { index <- obj_int32 ptr value <- object ptr } andCode: :index value { if: (index num) >= 0 && (index num) < size { data set: (index num) value } self } llMessage: foreach withVars: { clos <- lambda ptr i <- uint32_t index <- obj_int32 ptr } andCode: :clos { i <- 0 while: { i < size } do: { index <- make_object: (addr_of: obj_int32_meta) NULL 0 index num!: i ccall: clos 2 index (data get: i) i <- i + 1 } self } llMessage: append withVars: { value <- object ptr tmp <- (object ptr) ptr } andCode: :value { if: storage = size { storage <- storage * 2 tmp <- GC_REALLOC: data storage * (sizeof: (object ptr)) if: (not: tmp) { fputs: "Failed to increase array size\n" stderr exit: 1 } data <- tmp } data set: size value size <- size + 1 self } llMessage: resize withVars: { newsize <- obj_uint32 ptr tmp <- (object ptr) ptr } andCode: :newsize { self storage!: (newsize num) tmp <- GC_REALLOC: data storage * (sizeof: (object ptr)) if: (not: tmp) { fputs: "Failed to adjust array size\n" stderr exit: 1 } data <- tmp if: size > storage { size <- storage } self } llMessage: length withVars: { intret <- obj_int32 ptr } andCode: { intret <- make_object: (addr_of: obj_int32_meta) NULL 0 intret num!: size intret } fold:with <- :acc :fun { foreach: self :idx el { acc <- fun: acc el } acc } foldr:with <- :acc :fun { idx <- length - 1 while: {idx >= 0} do: { acc <- fun: acc (get: idx) } acc } map <- :fun { new <- #[] foreach: self :idx el { new append: (fun: el) } new } find:withDefault <- :pred :default{ idx <- 0 l <- length ret <- default while: {idx < l} do: { v <- get: idx if: (pred: v) { ret <- #{ key <- idx value <- v } idx <- l } } ret } join <- :sep { if: length > 0 { str <- string: (get: 0) idx <- 1 l <- length while: { idx < l } do: { str <- str . sep . (get: idx) idx <- idx + 1 } str } else: { "" } } }