From ab7b946a980475cad1e58186ac8c929c7659f529 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 10 May 2015 10:37:06 -0400 Subject: - Now analysing function-application backwards. --- src/lux/analyser.clj | 75 +++++++++++++++++++++++----------------------- src/lux/analyser/lux.clj | 77 ++++++++++++++++++++++++------------------------ src/lux/compiler.clj | 4 +-- src/lux/compiler/lux.clj | 9 ++++-- 4 files changed, 84 insertions(+), 81 deletions(-) (limited to 'src') diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 8fad07dfa..939a3ea0a 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -26,44 +26,45 @@ ["lux;Nil" _]]]]]]]]] (&/T catch+ ?finally-body))) -(defn ^:private aba1 [analyse eval! exo-type token] - (matchv ::M/objects [token] - ;; Standard special forms - [["lux;Meta" [meta ["lux;Bool" ?value]]]] - (|do [_ (&type/check exo-type &type/Bool)] - (return (&/|list (&/T (&/V "bool" ?value) exo-type)))) - - [["lux;Meta" [meta ["lux;Int" ?value]]]] - (|do [_ (&type/check exo-type &type/Int)] - (return (&/|list (&/T (&/V "int" ?value) exo-type)))) - - [["lux;Meta" [meta ["lux;Real" ?value]]]] - (|do [_ (&type/check exo-type &type/Real)] - (return (&/|list (&/T (&/V "real" ?value) exo-type)))) - - [["lux;Meta" [meta ["lux;Char" ?value]]]] - (|do [_ (&type/check exo-type &type/Char)] - (return (&/|list (&/T (&/V "char" ?value) exo-type)))) - - [["lux;Meta" [meta ["lux;Text" ?value]]]] - (|do [_ (&type/check exo-type &type/Text)] - (return (&/|list (&/T (&/V "text" ?value) exo-type)))) - - [["lux;Meta" [meta ["lux;Tuple" ?elems]]]] - (&&lux/analyse-tuple analyse exo-type ?elems) +(let [unit (&/V "lux;Meta" (&/T (&/T "" -1 -1) (&/V "lux;Tuple" (|list))))] + (defn ^:private aba1 [analyse eval! exo-type token] + (matchv ::M/objects [token] + ;; Standard special forms + [["lux;Meta" [meta ["lux;Bool" ?value]]]] + (|do [_ (&type/check exo-type &type/Bool)] + (return (&/|list (&/T (&/V "bool" ?value) exo-type)))) + + [["lux;Meta" [meta ["lux;Int" ?value]]]] + (|do [_ (&type/check exo-type &type/Int)] + (return (&/|list (&/T (&/V "int" ?value) exo-type)))) + + [["lux;Meta" [meta ["lux;Real" ?value]]]] + (|do [_ (&type/check exo-type &type/Real)] + (return (&/|list (&/T (&/V "real" ?value) exo-type)))) + + [["lux;Meta" [meta ["lux;Char" ?value]]]] + (|do [_ (&type/check exo-type &type/Char)] + (return (&/|list (&/T (&/V "char" ?value) exo-type)))) + + [["lux;Meta" [meta ["lux;Text" ?value]]]] + (|do [_ (&type/check exo-type &type/Text)] + (return (&/|list (&/T (&/V "text" ?value) exo-type)))) + + [["lux;Meta" [meta ["lux;Tuple" ?elems]]]] + (&&lux/analyse-tuple analyse exo-type ?elems) + + [["lux;Meta" [meta ["lux;Record" ?elems]]]] + (&&lux/analyse-record analyse exo-type ?elems) + + [["lux;Meta" [meta ["lux;Tag" ?ident]]]] + (&&lux/analyse-variant analyse exo-type ?ident unit) + + [["lux;Meta" [meta ["lux;Symbol" [_ "jvm-null"]]]]] + (return (&/|list (&/T (&/V "jvm-null" nil) (&/V "lux;DataT" "null")))) - [["lux;Meta" [meta ["lux;Record" ?elems]]]] - (&&lux/analyse-record analyse exo-type ?elems) - - [["lux;Meta" [meta ["lux;Tag" ?ident]]]] - (&&lux/analyse-variant analyse exo-type ?ident (&/V "lux;Meta" (&/T (&/T "" -1 -1) (&/V "lux;Tuple" (|list))))) - - [["lux;Meta" [meta ["lux;Symbol" [_ "jvm-null"]]]]] - (return (&/|list (&/T (&/V "jvm-null" nil) (&/V "lux;DataT" "null")))) - - [_] - (fail "") - )) + [_] + (fail "") + ))) (defn ^:private aba2 [analyse eval! exo-type token] (matchv ::M/objects [token] diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index df87a08b6..e4237d8dd 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -172,42 +172,39 @@ ))) )) -(defn ^:private analyse-apply* [analyse exo-type =fn ?args] - (matchv ::M/objects [=fn] - [[?fun-expr ?fun-type]] - (matchv ::M/objects [?args] - [["lux;Nil" _]] - (|do [_ (&type/check exo-type ?fun-type)] - (return =fn)) - - [["lux;Cons" [?arg ?args*]]] - (|do [?fun-type* (&type/actual-type ?fun-type)] - (matchv ::M/objects [?fun-type*] - [["lux;AllT" _]] - (&type/with-var - (fn [$var] - (|do [type* (&type/apply-type ?fun-type* $var) - output (analyse-apply* analyse exo-type (&/T ?fun-expr type*) ?args)] - (matchv ::M/objects [output $var] - [[?expr* ?type*] ["lux;VarT" ?id]] - (|do [? (&type/bound? ?id) - _ (if ? - (return nil) - (|do [ex &type/existential] - (&type/set-var ?id ex))) - type** (&type/clean $var ?type*)] - (return (&/T ?expr* type**))) - )))) - - [["lux;LambdaT" [?input-t ?output-t]]] - (|do [=arg (&&/analyse-1 analyse ?input-t ?arg)] - (analyse-apply* analyse exo-type (&/T (&/V "apply" (&/T =fn =arg)) - ?output-t) - ?args*)) +(defn ^:private analyse-apply* [analyse exo-type fun-type args] + (matchv ::M/objects [args] + [["lux;Nil" _]] + (|do [_ (&type/check exo-type fun-type)] + (return (&/T (&/|list) fun-type))) + + [["lux;Cons" [?arg ?args*]]] + (|do [?fun-type* (&type/actual-type fun-type)] + (matchv ::M/objects [?fun-type*] + [["lux;AllT" _]] + (&type/with-var + (fn [$var] + (|do [type* (&type/apply-type ?fun-type* $var) + [?args** ?type**] (analyse-apply* analyse exo-type type* args)] + (matchv ::M/objects [$var] + [["lux;VarT" ?id]] + (|do [? (&type/bound? ?id) + _ (if ? + (return nil) + (|do [ex &type/existential] + (&type/set-var ?id ex))) + type*** (&type/clean $var ?type**)] + (return (&/T ?args** type***))) + )))) + + [["lux;LambdaT" [?input-t ?output-t]]] + (|do [[=args ?output-t*] (analyse-apply* analyse exo-type ?output-t ?args*) + =arg (&&/analyse-1 analyse ?input-t ?arg)] + (return (&/T (&/|cons =arg =args) ?output-t*))) - [_] - (fail (str "[Analyser Error] Can't apply a non-function: " (&type/show-type ?fun-type*))))) - ))) + [_] + (fail (str "[Analyser Error] Can't apply a non-function: " (&type/show-type ?fun-type*))))) + )) (defn analyse-apply [analyse exo-type =fn ?args] (|do [loader &/loader] @@ -222,12 +219,14 @@ (&/flat-map% (partial analyse exo-type) macro-expansion)) [_] - (|do [output (analyse-apply* analyse exo-type =fn ?args)] - (return (&/|list output))))) + (|do [[=args =app-type] (analyse-apply* analyse exo-type =fn-type ?args)] + (return (&/|list (&/T (&/V "apply" (&/T =fn =args)) + =app-type)))))) [_] - (|do [output (analyse-apply* analyse exo-type =fn ?args)] - (return (&/|list output)))) + (|do [[=args =app-type] (analyse-apply* analyse exo-type =fn-type ?args)] + (return (&/|list (&/T (&/V "apply" (&/T =fn =args)) + =app-type))))) ))) (defn analyse-case [analyse exo-type ?value ?branches] diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 40bb3a710..6739c5529 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -60,8 +60,8 @@ [["lux;Global" [?owner-class ?name]]] (&&lux/compile-global compile-expression ?type ?owner-class ?name) - [["apply" [?fn ?arg]]] - (&&lux/compile-apply compile-expression ?type ?fn ?arg) + [["apply" [?fn ?args]]] + (&&lux/compile-apply compile-expression ?type ?fn ?args) [["variant" [?tag ?members]]] (&&lux/compile-variant compile-expression ?type ?tag ?members) diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index cf4a65f04..2c5073a4d 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -117,11 +117,14 @@ :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (&host/->class (&host/location (&/|list ?owner-class ?name))) "_datum" "Ljava/lang/Object;")]] (return nil))) -(defn compile-apply [compile *type* ?fn ?arg] +(defn compile-apply [compile *type* ?fn ?args] (|do [^MethodVisitor *writer* &/get-writer _ (compile ?fn) - _ (compile ?arg) - :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE "lux/Function" "apply" &&/apply-signature)]] + _ (&/map% (fn [?arg] + (|do [_ (compile ?arg) + :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE "lux/Function" "apply" &&/apply-signature)]] + (return nil))) + ?args)] (return nil))) (defn compile-def [compile ?name ?body ?def-data] -- cgit v1.2.3