From bcf0cb737e348dc9e183b1608abbebc5a40ba847 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 2 Aug 2015 22:38:43 -0400 Subject: - Added a module for hashing. - Refactored the standard library a bit. - Implemented the "loop" macro. - Added the expected type of expressions as a field in the compiler state. - Added syntactic sugar for using tuples with variants, in order to minimize the usage of brackets to delimit the contents of data-structures. - Fixed a bug wherein "macro-expand" was behaving like "macro-expand-all", and added a separate implementation for "macro-expand-all". - Fixed a few bugs. --- src/lux/analyser.clj | 103 +++++++++++++++++++++++----------------------- src/lux/analyser/case.clj | 17 ++++---- src/lux/analyser/lux.clj | 39 ++++++++++++++---- src/lux/base.clj | 30 +++++++++++--- src/lux/compiler/io.clj | 2 +- src/lux/type.clj | 4 +- 6 files changed, 121 insertions(+), 74 deletions(-) (limited to 'src') diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index de7fc8497..f10f6b913 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -446,45 +446,44 @@ [_] (aba3 analyse eval! compile-module exo-type token))) -(let [unit (&/V "lux;Meta" (&/T (&/T "" -1 -1) (&/V "lux;TupleS" (&/|list))))] - (defn ^:private aba1 [analyse eval! compile-module exo-type token] - (matchv ::M/objects [token] - ;; Standard special forms - [["lux;BoolS" ?value]] - (|do [_ (&type/check exo-type &type/Bool)] - (return (&/|list (&/T (&/V "bool" ?value) exo-type)))) +(defn ^:private aba1 [analyse eval! compile-module exo-type token] + (matchv ::M/objects [token] + ;; Standard special forms + [["lux;BoolS" ?value]] + (|do [_ (&type/check exo-type &type/Bool)] + (return (&/|list (&/T (&/V "bool" ?value) exo-type)))) - [["lux;IntS" ?value]] - (|do [_ (&type/check exo-type &type/Int)] - (return (&/|list (&/T (&/V "int" ?value) exo-type)))) + [["lux;IntS" ?value]] + (|do [_ (&type/check exo-type &type/Int)] + (return (&/|list (&/T (&/V "int" ?value) exo-type)))) - [["lux;RealS" ?value]] - (|do [_ (&type/check exo-type &type/Real)] - (return (&/|list (&/T (&/V "real" ?value) exo-type)))) + [["lux;RealS" ?value]] + (|do [_ (&type/check exo-type &type/Real)] + (return (&/|list (&/T (&/V "real" ?value) exo-type)))) - [["lux;CharS" ?value]] - (|do [_ (&type/check exo-type &type/Char)] - (return (&/|list (&/T (&/V "char" ?value) exo-type)))) + [["lux;CharS" ?value]] + (|do [_ (&type/check exo-type &type/Char)] + (return (&/|list (&/T (&/V "char" ?value) exo-type)))) - [["lux;TextS" ?value]] - (|do [_ (&type/check exo-type &type/Text)] - (return (&/|list (&/T (&/V "text" ?value) exo-type)))) + [["lux;TextS" ?value]] + (|do [_ (&type/check exo-type &type/Text)] + (return (&/|list (&/T (&/V "text" ?value) exo-type)))) - [["lux;TupleS" ?elems]] - (&&lux/analyse-tuple analyse exo-type ?elems) + [["lux;TupleS" ?elems]] + (&&lux/analyse-tuple analyse exo-type ?elems) - [["lux;RecordS" ?elems]] - (&&lux/analyse-record analyse exo-type ?elems) + [["lux;RecordS" ?elems]] + (&&lux/analyse-record analyse exo-type ?elems) - [["lux;TagS" ?ident]] - (&&lux/analyse-variant analyse exo-type ?ident unit) - - [["lux;SymbolS" [_ "_jvm_null"]]] - (&&host/analyse-jvm-null analyse exo-type) + [["lux;TagS" ?ident]] + (&&lux/analyse-variant analyse exo-type ?ident (&/|list)) + + [["lux;SymbolS" [_ "_jvm_null"]]] + (&&host/analyse-jvm-null analyse exo-type) - [_] - (aba2 analyse eval! compile-module exo-type token) - ))) + [_] + (aba2 analyse eval! compile-module exo-type token) + )) (defn ^:private add-loc [meta ^String msg] (if (.startsWith msg "@") @@ -512,10 +511,10 @@ ;; (assert false (aget token 0)) )) -(defn ^:private just-analyse [analyse-ast eval! compile-module syntax] +(defn ^:private just-analyse [analyser syntax] (&type/with-var (fn [?var] - (|do [[?output-term ?output-type] (&&/analyse-1 (partial analyse-ast eval! compile-module) ?var syntax)] + (|do [[?output-term ?output-type] (&&/analyse-1 analyser ?var syntax)] (matchv ::M/objects [?var ?output-type] [["lux;VarT" ?e-id] ["lux;VarT" ?a-id]] (if (= ?e-id ?a-id) @@ -528,25 +527,25 @@ )))) (defn ^:private analyse-ast [eval! compile-module exo-type token] - (matchv ::M/objects [token] - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;TagS" ?ident]]] ?values]]]]]] - (do (assert (.equals ^Object (&/|length ?values) 1) "[Analyser Error] Can only tag 1 value.") - (&&lux/analyse-variant (partial analyse-ast eval! compile-module) exo-type ?ident (&/|head ?values))) - - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [?fn ?args]]]]]] - (fn [state] - (matchv ::M/objects [((just-analyse analyse-ast eval! compile-module ?fn) state) - ;; ((&type/with-var #(&&/analyse-1 (partial analyse-ast eval! compile-module) % ?fn)) state) - ] - [["lux;Right" [state* =fn]]] - (do ;; (prn 'GOT_FUN (&/show-ast ?fn) (&/show-ast token) (aget =fn 0 0) (aget =fn 1 0)) - ((&&lux/analyse-apply (partial analyse-ast eval! compile-module) exo-type meta =fn ?args) state*)) - - [_] - ((analyse-basic-ast (partial analyse-ast eval! compile-module) eval! compile-module exo-type token) state))) - - [_] - (analyse-basic-ast (partial analyse-ast eval! compile-module) eval! compile-module exo-type token))) + (&/with-expected-type exo-type + (matchv ::M/objects [token] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;TagS" ?ident]]] ?values]]]]]] + (&&lux/analyse-variant (partial analyse-ast eval! compile-module) exo-type ?ident ?values) + + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [?fn ?args]]]]]] + (fn [state] + (matchv ::M/objects [((just-analyse (partial analyse-ast eval! compile-module) ?fn) state) + ;; ((&type/with-var #(&&/analyse-1 (partial analyse-ast eval! compile-module) % ?fn)) state) + ] + [["lux;Right" [state* =fn]]] + (do ;; (prn 'GOT_FUN (&/show-ast ?fn) (&/show-ast token) (aget =fn 0 0) (aget =fn 1 0)) + ((&&lux/analyse-apply (partial analyse-ast eval! compile-module) exo-type meta =fn ?args) state*)) + + [_] + ((analyse-basic-ast (partial analyse-ast eval! compile-module) eval! compile-module exo-type token) state))) + + [_] + (analyse-basic-ast (partial analyse-ast eval! compile-module) eval! compile-module exo-type token)))) ;; [Resources] (defn analyse [eval! compile-module] diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj index ebbb6911a..77f8c418c 100644 --- a/src/lux/analyser/case.clj +++ b/src/lux/analyser/case.clj @@ -16,6 +16,9 @@ [env :as &env]))) ;; [Utils] +(def ^:private unit + (&/V "lux;Meta" (&/T (&/T "" -1 -1) (&/V "lux;TupleS" (&/|list))))) + (defn ^:private resolve-type [type] (matchv ::M/objects [type] [["lux;VarT" ?id]] @@ -198,19 +201,19 @@ (|do [=tag (&&/resolved-ident ?ident) value-type* (adjust-type value-type) case-type (&type/variant-case =tag value-type*) - [=test =kont] (analyse-pattern case-type (&/V "lux;Meta" (&/T (&/T "" -1 -1) - (&/V "lux;TupleS" (&/|list)))) - kont)] + [=test =kont] (analyse-pattern case-type unit kont)] (return (&/T (&/V "VariantTestAC" (&/T =tag =test)) =kont))) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;TagS" ?ident]]] - ["lux;Cons" [?value - ["lux;Nil" _]]]]]]] + ?values]]]] (|do [=tag (&&/resolved-ident ?ident) value-type* (adjust-type value-type) case-type (&type/variant-case =tag value-type*) - [=test =kont] (analyse-pattern case-type ?value - kont)] + [=test =kont] (case (&/|length ?values) + 0 (analyse-pattern case-type unit kont) + 1 (analyse-pattern case-type (&/|head ?values) kont) + ;; 1+ + (analyse-pattern case-type (&/V "lux;Meta" (&/T (&/T "" -1 -1) (&/V "lux;TupleS" ?values))) kont))] (return (&/T (&/V "VariantTestAC" (&/T =tag =test)) =kont))) ))) diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 065e150d9..4fb9d1533 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -55,7 +55,25 @@ [_] (fail (str "[Analyser Error] Tuples require tuple-types: " (&type/show-type exo-type*)))))) -(defn analyse-variant [analyse exo-type ident ?value] +(defn ^:private analyse-variant-body [analyse exo-type ?values] + (|do [output (matchv ::M/objects [?values] + [["lux;Nil" _]] + (analyse-tuple analyse exo-type (&/|list)) + + [["lux;Cons" [?value ["lux;Nil" _]]]] + (analyse exo-type ?value) + + [_] + (analyse-tuple analyse exo-type ?values) + )] + (matchv ::M/objects [output] + [["lux;Cons" [x ["lux;Nil" _]]]] + (return x) + + [_] + (fail "[Analyser Error] Can't expand to other than 1 element.")))) + +(defn analyse-variant [analyse exo-type ident ?values] (|do [exo-type* (matchv ::M/objects [exo-type] [["lux;VarT" ?id]] (&/try-all% (&/|list (|do [exo-type* (&type/deref ?id)] @@ -69,7 +87,7 @@ [["lux;VariantT" ?cases]] (|do [?tag (&&/resolved-ident ident)] (if-let [vtype (&/|get ?tag ?cases)] - (|do [=value (&&/analyse-1 analyse vtype ?value)] + (|do [=value (analyse-variant-body analyse vtype ?values)] (return (&/|list (&/T (&/V "variant" (&/T ?tag =value)) exo-type)))) (fail (str "[Analyser Error] There is no case " ?tag " for variant type " (&type/show-type exo-type*))))) @@ -78,7 +96,7 @@ (&type/with-var (fn [$var] (|do [exo-type** (&type/apply-type exo-type* $var)] - (analyse-variant analyse exo-type** ident ?value)))) + (analyse-variant analyse exo-type** ident ?values)))) [_] (fail (str "[Analyser Error] Can't create a variant if the expected type is " (&type/show-type exo-type*)))))) @@ -108,6 +126,8 @@ (fail (str "[Analyser Error] The type of a record must be a record type:\n" (&type/show-type exo-type*) "\n"))) + _ (&/assert! (= (&/|length types) (&/|length ?elems)) + (str "[Analyser Error] Record length mismatch. Expected: " (&/|length types) "; actual: " (&/|length ?elems))) =slots (&/map% (fn [kv] (matchv ::M/objects [kv] [[["lux;Meta" [_ ["lux;TagS" ?ident]]] ?value]] @@ -258,14 +278,17 @@ (|do [[[r-module r-name] $def] (&&module/find-def ?module ?name)] (matchv ::M/objects [$def] [["lux;MacroD" macro]] - (|do [macro-expansion #(-> macro (.apply ?args) (.apply %)) + (|do [;; :let [_ (prn 'MACRO-EXPAND|PRE (str r-module ";" r-name))] + macro-expansion #(-> macro (.apply ?args) (.apply %)) + ;; :let [_ (prn 'MACRO-EXPAND|POST (str r-module ";" r-name))] :let [macro-expansion* (&/|map (partial with-cursor form-cursor) macro-expansion)] - ;; :let [_ (when (and ;; (= "lux/control/monad" ?module) - ;; (= "case" ?name)) + ;; :let [_ (when (or (= "loop" r-name) + ;; ;; (= "struct" r-name) + ;; ) ;; (->> (&/|map &/show-ast macro-expansion*) ;; (&/|interpose "\n") ;; (&/fold str "") - ;; (prn ?module "case")))] + ;; (prn (str r-module ";" r-name))))] ] (&/flat-map% (partial analyse exo-type) macro-expansion*)) @@ -356,6 +379,8 @@ (defn analyse-def [analyse ?name ?value] ;; (prn 'analyse-def/BEGIN ?name) + ;; (when (= "PList/Dict" ?name) + ;; (prn 'DEF ?name (&/show-ast ?value))) (|do [module-name &/get-module-name ? (&&module/defined? module-name ?name)] (if ? diff --git a/src/lux/base.clj b/src/lux/base.clj index eb94c2c90..ef3c81041 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -11,6 +11,9 @@ [clojure.core.match :as M :refer [matchv]] clojure.core.match.array)) +;; [Tags] +(def $Cons "lux;Cons") + ;; [Fields] ;; Binding (def $COUNTER 0) @@ -27,14 +30,15 @@ (def $LOADER 1) (def $WRITER 2) -;; CompilerState +;; Compiler (def $ENVS 0) (def $EVAL? 1) -(def $HOST 2) -(def $MODULES 3) -(def $SEED 4) -(def $SOURCE 5) -(def $TYPES 6) +(def $EXPECTED 2) +(def $HOST 3) +(def $MODULES 4) +(def $SEED 5) +(def $SOURCE 6) +(def $TYPES 7) ;; [Exports] (def +name-separator+ ";") @@ -487,6 +491,8 @@ (|list) ;; "lux;eval?" false + ;; "lux;expected" + (V "lux;VariantT" (|list)) ;; "lux;host" (host nil) ;; "lux;modules" @@ -610,6 +616,18 @@ [_] output)))) +(defn with-expected-type [type body] + "(All [a] (-> Type (Lux a)))" + (fn [state] + (let [output (body (set$ $EXPECTED type state))] + (matchv ::M/objects [output] + [["lux;Right" [?state ?value]]] + (return* (set$ $EXPECTED (get$ $EXPECTED state) ?state) + ?value) + + [_] + output)))) + (defn show-ast [ast] (matchv ::M/objects [ast] [["lux;Meta" [_ ["lux;BoolS" ?value]]]] diff --git a/src/lux/compiler/io.clj b/src/lux/compiler/io.clj index 176b4340d..0e7982a7f 100644 --- a/src/lux/compiler/io.clj +++ b/src/lux/compiler/io.clj @@ -11,7 +11,7 @@ )) ;; [Resources] -(defn read-file [path] +(defn read-file [^String path] (let [file (new java.io.File path)] (if (.exists file) (return (slurp file)) diff --git a/src/lux/type.clj b/src/lux/type.clj index f5b8d3f25..e3255ac5c 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -177,7 +177,9 @@ (&/T "lux;types" (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Bindings Int)) Type))) (&/T "lux;host" HostState) (&/T "lux;seed" Int) - (&/T "lux;eval?" Bool)))) + (&/T "lux;eval?" Bool) + (&/T "lux;expected" Type) + ))) $Void))) (def Macro -- cgit v1.2.3