From a31500f27a29c34877e94188fad1abac3fefb576 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 1 May 2015 19:01:20 -0400 Subject: - Added the lux;seed slot to the compiler state. - Macro declarations are now handled at the compiler-phase instead of the analyser phase to avoid the posibility of trying to declare a yet-uncompiled macro (due to the macro-expansion of defmacro). - Added a makeshift implementation of existential types on top of BoundT (must migrate to a more permanent implementation). --- src/lux/analyser/lux.clj | 16 ++++++++++- src/lux/base.clj | 12 ++++++-- src/lux/compiler.clj | 3 ++ src/lux/compiler/lux.clj | 4 +++ src/lux/type.clj | 73 ++++++++++++++++++++++++++++-------------------- 5 files changed, 74 insertions(+), 34 deletions(-) (limited to 'src') diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 7c9b9b5f0..191a16235 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -320,7 +320,17 @@ (|do [? (&type/bound? ?id)] (if ? (|do [dtype (&type/deref ?id)] - (fail (str "[Analyser Error] Can't use type-var in any type-specific way inside polymorphic functions: " ?id ":" _arg " " (&type/show-type dtype)))) + (matchv ::M/objects [dtype] + [["lux;BoundT" _]] + (matchv ::M/objects [output] + [["Expression" [_expr _]]] + ;; (|do [_ (&type/set-var ?id (&/V "lux;BoundT" _arg))] + ;; (return (&/V "Expression" (&/T _expr exo-type)))) + (return (&/V "Expression" (&/T _expr exo-type))) + ) + + [_] + (fail (str "[Analyser Error] Can't use type-var in any type-specific way inside polymorphic functions: " ?id ":" _arg " " (&type/show-type dtype))))) (matchv ::M/objects [output] [["Expression" [_expr _]]] ;; (|do [_ (&type/set-var ?id (&/V "lux;BoundT" _arg))] @@ -388,6 +398,10 @@ _ (&&module/declare-macro module-name ?name)] (return (&/|list)))) +(defn analyse-declare-macro [analyse ?name] + (|do [module-name &/get-module-name] + (return (&/|list (&/V "Statement" (&/V "declare-macro" (&/T module-name ?name))))))) + (defn analyse-import [analyse exo-type ?path] (return (&/|list))) diff --git a/src/lux/base.clj b/src/lux/base.clj index 4f3e6f028..306c09b19 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -24,8 +24,9 @@ (def $HOST 1) (def $MODULE-ALIASES 2) (def $MODULES 3) -(def $SOURCE 4) -(def $TYPES 5) +(def $SEED 4) +(def $SOURCE 5) +(def $TYPES 6) ;; [Exports] (def +name-separator+ ";") @@ -555,6 +556,8 @@ (|table) ;; "lux;modules" (|table) + ;; "lux;seed" + 0 ;; "lux;source" (V "lux;None" nil) ;; "lux;types" @@ -593,6 +596,11 @@ (catch Throwable _ (fail* "No local environment."))))) +(def gen-id + (fn [state] + (let [seed (get$ $SEED state)] + (return* (set$ $SEED (inc seed) state) seed)))) + (defn ->seq [xs] (matchv ::M/objects [xs] [["lux;Nil" _]] diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 6a9cc58c6..e6879f4da 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -317,6 +317,9 @@ (matchv ::M/objects [?form] [["def" [?name ?body ?def-data]]] (&&lux/compile-def compile-expression ?name ?body ?def-data) + + [["declare-macro" [?module ?name]]] + (&&lux/compile-declare-macro compile-expression ?module ?name) [["jvm-interface" [?package ?name ?methods]]] (&&host/compile-jvm-interface compile-expression ?package ?name ?methods) diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index 1553d3975..35a706f05 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -165,3 +165,7 @@ ;; :let [_ (prn 'compile-def/_2 ?name)] ] (return nil))) + +(defn compile-declare-macro [compile module name] + (|do [_ (&a-module/declare-macro module name)] + (return nil))) diff --git a/src/lux/type.clj b/src/lux/type.clj index 217a167a4..b739be3c2 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -150,7 +150,8 @@ (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Env Text)) $Void))))) (&/T "lux;types" (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Bindings Int)) Type))) - (&/T "lux;host" HostState)))) + (&/T "lux;host" HostState) + (&/T "lux;seed" Int)))) $Void))) (def Macro @@ -212,37 +213,42 @@ (declare clean*) (defn ^:private delete-var [id] - (fn [state] - (&/run-state (|do [mappings* (&/map% (fn [binding] - (|let [[?id ?type] binding] - (if (= id ?id) - (return binding) - (matchv ::M/objects [?type] - [["lux;None" _]] + (|do [? (bound? id) + _ (if ? + (return nil) + (|do [seed &/gen-id] + (set-var id (&/V "lux;BoundT" (str seed)))))] + (fn [state] + (&/run-state (|do [mappings* (&/map% (fn [binding] + (|let [[?id ?type] binding] + (if (= id ?id) (return binding) - - [["lux;Some" ?type*]] - (matchv ::M/objects [?type*] - [["lux;VarT" ?id*]] - (if (= id ?id*) - (return (&/T ?id (&/V "lux;None" nil))) - (return binding) - ;; (|do [?type** (clean* id ?type*)] - ;; (return (&/T ?id (&/V "lux;Some" ?type**)))) - ) - - [_] - (|do [?type** (clean* id ?type*)] - (return (&/T ?id (&/V "lux;Some" ?type**))))) - )))) - (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS)))] - (fn [state] - (return* (&/update$ &/$TYPES #(->> % - (&/update$ &/$COUNTER dec) - (&/set$ &/$MAPPINGS (&/|remove id mappings*))) - state) - nil))) - state))) + (matchv ::M/objects [?type] + [["lux;None" _]] + (return binding) + + [["lux;Some" ?type*]] + (matchv ::M/objects [?type*] + [["lux;VarT" ?id*]] + (if (= id ?id*) + (return (&/T ?id (&/V "lux;None" nil))) + (return binding) + ;; (|do [?type** (clean* id ?type*)] + ;; (return (&/T ?id (&/V "lux;Some" ?type**)))) + ) + + [_] + (|do [?type** (clean* id ?type*)] + (return (&/T ?id (&/V "lux;Some" ?type**))))) + )))) + (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS)))] + (fn [state] + (return* (&/update$ &/$TYPES #(->> % + (&/update$ &/$COUNTER dec) + (&/set$ &/$MAPPINGS (&/|remove id mappings*))) + state) + nil))) + state)))) (defn with-var [k] (|do [id create-var @@ -749,6 +755,11 @@ (return (&/T fixpoints* nil))) (fail "[Type Error] Records don't match in size.")) + [["lux;BoundT" e!name] ["lux;BoundT" a!name]] + (if (= e!name a!name) + (return (&/T fixpoints nil)) + (check-error expected actual)) + [_ _] (fail (println-str "[Type Error] Can't type-check: " (show-type expected) (show-type actual))) )) -- cgit v1.2.3