diff --git a/go.fnl b/go.fnl index 6806f29..34ae4f8 100644 --- a/go.fnl +++ b/go.fnl @@ -1,7 +1,28 @@ (local fennel (require :fennel)) -(import-macros {: terra : unterra : def : q} :terra) +(import-macros {: terra : unterra : untype : def : q : ttype} :terra) -(local N 5) -(print (unterra (def [x int] (return (+ x N))))) -(local inc (def [x int] (return (+ x N)))) -(print (inc 5)) +; (local N 5) +; (print (unterra +; (def [x [int] : int64] +; (var y (+ x N)) +; (return (cast int64 (& [y])))))) +(print (untype + {key int + :union { + string [int8] + number float + complex {real float imag float} + } + })) + +(print (fennel.view (ttype + {key int + :union { + string [int8] + number float + complex {real float imag float} + } + }))) + +; (local inc (def [x [int]] (return [x N]))) +; (print (inc 5)) diff --git a/terra.fnl b/terra.fnl index ac64859..2cbae5a 100644 --- a/terra.fnl +++ b/terra.fnl @@ -4,6 +4,9 @@ (let [str (tostring (gensym name))] (str:gsub "[^%w_]" #(string.format "_%02x" ($:byte))))) +(fn kv-table? [tbl] ; this should be exported to macros but is not ;_; + (and (table? tbl) (not (sequence? tbl)))) + (fn new-scope [] {:locals {} :env {} @@ -11,9 +14,12 @@ :push (fn [self] (set self.locals (setmetatable {} {:__index self.locals}))) :pop (fn [self] (set self.locals (. (getmetatable self.locals) :__index))) :expr (fn [self expr] - (let [name (safesym :inline-expr)] - (table.insert self.input {: name : expr}) - name)) + (if (and (sym? expr) (not (multi-sym? expr))) (self:env-ref expr) + (= (type expr) :number) (tostring expr) + (= expr nil) :nil + (let [name (safesym :inline-expr)] + (table.insert self.input {: name : expr}) + name))) :env-ref (fn [self symbol] (let [name (tostring symbol) loc (. self.env name)] @@ -32,27 +38,30 @@ (tset self.locals name loc) loc))}) +(local comp {}) (local forms {}) (fn commasep [list f] (table.concat (icollect [_ v (ipairs list)] (f v)) ", ")) +(fn kvcommasep [tbl f] + (commasep (. (getmetatable tbl) :keys) #(f $1 (. tbl $1)))) -(fn comp-expr [form scope] +(fn comp.expr [form scope] (case form - (where [head & rest] (sym? head) (list? form) (. forms (tostring head))) + (where [head & rest] (sym? head) (list? form) (. forms (tostring head))) ((. forms (tostring head)) rest scope) - (where [head & rest] (sym? head) (list? form)) - (.. (comp-expr head scope) "(" (commasep rest #(comp-expr $1 scope)) ")") + (where [head & rest] (list? form)) + (.. (comp.expr head scope) "(" (commasep rest #(comp.expr $1 scope)) ")") - (where [escape] (sequence? form)) - (scope:expr escape) + (where [array] (sequence? form) (= (length form) 1)) + (.. "@" (comp.expr array scope)) - (where str (= (type str) :string)) - (scope:expr str) + (where [array & indexes] (sequence? form)) + (.. "(" (comp.expr array scope) ")" (table.concat (icollect [_ i (ipairs indexes)] (.. "[" (comp.expr i scope) "]")))) - (where num (= (type num) :number)) - (tostring num) + (where struct (kv-table? struct)) + (.. "{ " (kvcommasep struct #(.. (tostring $1) " = " (comp.expr $2 scope))) " }") (where multisym (multi-sym? multisym)) (string.gsub (tostring multisym) "[^.:]+" #(scope:reference $1) 1) @@ -60,60 +69,94 @@ (where symbol (sym? symbol)) (scope:reference symbol) - nil - "nil" - + (where lit (or (= (type lit) :string) (= (type lit) :number) (= (type lit) :nil))) + (scope:expr lit) + _ (error (.. "Failed to parse expression: " (view form))))) -(fn comp-type [typ scope] +(local type-constructors {}) + +(fn comp.type [typ scope] (case typ - (where typlist (sequence? typlist)) - (.. "{" (commasep typlist #(comp-type $1 scope)) "}") + (where [innertyp index] (sequence? typ)) + (.. "(" (comp.type innertyp scope) ")[" (comp.type index scope) "]") - (where [vec typ n] (list? typ) (= (type n) :number) (= vec (sym :vec))) - (.. "vector(" (comp-type typ scope) ", " (tostring n) ")") + (where [innertyp] (sequence? typ) (= (length typ) 1)) + (.. "&" (comp.type innertyp scope)) - (where tuple (list? tuple)) - (.. "tuple(" (commasep tuple #(comp-type $1 scope)) ")") + (where struct (kv-table? struct)) + (.. "struct { " (kvcommasep struct #(comp.type-field $1 $2 scope)) " }") - (where [to in out] (list? typ) (= to (sym :->))) - (.. (comp-type in scope) " -> " (comp-type out scope)) + (where [head & args] (list? typ) (sym? head) (. type-constructors (tostring head))) + ((. type-constructors (tostring head)) args scope) - (where symbol (sym? symbol)) - (tostring symbol) + (where [head & args] (list? typ)) + (.. (comp.type head scope) "(" (commasep args #(comp.type $1 scope)) ")") - (where symbol (= (type symbol) :string)) - symbol + (where multisym (multi-sym? multisym)) + (string.gsub (tostring multisym) "[^.:]+" #(scope:reference $1) 1) + + _ (scope:expr typ))) + +(fn comp.type-field [name typ scope] + (case name + (where name (sym? name) (not (multi-sym? name))) + (.. (tostring name) " : " (comp.type typ scope)) - _ (error (.. "Failed to parse type: " (view typ))))) + :union + (.. "union { " (kvcommasep typ #(comp.type-field $1 $2 scope)) " }") ; unions shouldn't nest :/ + + _ (error (.. "Invalid field name: " (view name))))) + +(fn arglist-type [arglist scope] (.. "{ " (commasep (or arglist []) #(comp.type $1 scope)) " }")) +(tset type-constructors :-> (fn [[in out] scope] (.. (arglist-type in scope) " -> " (arglist-type out scope)))) +(tset type-constructors :& (fn [[typ] scope] (.. :& (comp.type typ scope)))) +(tset type-constructors :$ (fn [typs scope] (.. "tuple(" (commasep typs #(comp.type $1 scope)) ")"))) +(fn type-constructors.hashfn [[expr] scope] (scope:expr expr)) (fn forms.rawterra [[text] scope] text) -(fn forms.var [[name typ] scope] - (.. "var " (scope:addlocal name) " " (comp-type typ scope))) +(fn forms.var [defn scope] + (case defn + [name typ initval] (.. "var " (scope:addlocal name) " : " (comp.type typ scope) " = " (comp.expr initval scope)) + [name initval] (.. "var " (scope:addlocal name) " = " (comp.expr initval scope)))) (fn forms.do [stmts scope] (scope:push) - (local lines (icollect [_ stmt (ipairs stmts)] (comp-expr stmt scope))) + (local lines (icollect [_ stmt (ipairs stmts)] (comp.expr stmt scope))) (scope:pop) (table.concat lines "\n")) +(fn find-ival [tbl pred] + (var ival nil) + (each [i val (ipairs tbl)] + (when (pred val) (set ival i))) + ival) + (fn forms.def [[arglist & stmts] scope] (scope:push) - (let [argpairs (fcollect [i 1 (length arglist) 2] {:name (. arglist i) :type (. arglist (+ i 1))}) - _ (print (view argpairs)) - argdefs (commasep argpairs #(.. (scope:addlocal $1.name) " : " (comp-type $1.type scope))) - fulldef (.. "terra (" argdefs ")\n" (forms.do stmts scope) "\nend")] + (let [iarg-return-sep (find-ival arglist #(and (sym? $1) (= (tostring $1) ":"))) + argpairs (fcollect [i 1 (length arglist) 2 &until (= i iarg-return-sep)] + {:name (. arglist i) :type (. arglist (+ i 1))}) + rettyps (when iarg-return-sep (icollect [i typ (ipairs arglist)] (when (> i iarg-return-sep) typ))) + rettyp (if rettyps (.. ": { " (commasep rettyps #(comp.type $1 scope)) " }") "") + argdefs (commasep argpairs #(.. (scope:addlocal $1.name) " : " (comp.type $1.type scope))) + fulldef (.. "terra (" argdefs ")" rettyp "\n" (forms.do stmts scope) "\nend")] (scope:pop) fulldef)) -(fn forms.return [[expr] scope] (.. "return " (comp-expr expr scope))) +(fn forms.predef [fntyp scope] (.. )) +(fn forms.return [[expr] scope] (.. "return " (comp.expr expr scope))) +(fn forms.cast [[typ expr] scope] + (.. "([" (comp.type typ scope)"](" (comp.expr expr scope) "))")) +(fn forms.hashfn [[expr] scope] (.. "([" (scope:expr expr) "])")) + +(tset forms :& (fn [[expr] scope] (.. :& (comp.expr expr scope)))) +(tset forms :$ (fn [items scope] (.. "{ " (commasep items #(comp.expr $1 scope)) " }"))) + (fn def-infix [fnlop luaop] (tset forms fnlop (fn [[left right] scope] - (.. "(" (comp-expr left scope) " " luaop " " (comp-expr right scope) ")")))) + (.. "(" (comp.expr left scope) " " luaop " " (comp.expr right scope) ")")))) (each [_ op (ipairs [:+ :- :* :/ :% :< :<= :> :>= :and :or :not :^ :<< :>>])] (def-infix op op)) -(fn forms.cast [[typ expr] scope] - (.. "([" (comp-type typ scope)"]" (comp-expr expr scope) ")")) - (def-infix := :==) (def-infix :not= "~=") (def-infix :set :=) @@ -128,11 +171,12 @@ (icollect [_ {: expr} (ipairs scope.input) &into call] expr) call)) -(fn terra [expr] (build expr comp-expr)) -(fn ttype [expr] (build expr comp-type)) +(fn terra [expr] (build expr comp.expr)) +(fn ttype [expr] (build expr comp.type)) (fn def [...] (terra `(,(sym :def) ,...))) (fn q [...] (terra `(,(sym :quote) ,...))) (fn unterra [...] (view (macroexpand (terra ...)))) +(fn untype [...] (view (macroexpand (ttype ...)))) -{: terra : ttype : def : q : unterra} \ No newline at end of file +{: terra : ttype : def : q : unterra : untype} \ No newline at end of file