--- /dev/null
+package org.simantics.scl.compiler.elaboration.java;
+
+import org.cojen.classfile.TypeDesc;
+import org.simantics.databoard.binding.mutable.Variant;
+import org.simantics.scl.compiler.common.datatypes.Constructor;
+import org.simantics.scl.compiler.common.names.Name;
+import org.simantics.scl.compiler.constants.BooleanConstant;
+import org.simantics.scl.compiler.constants.Constant;
+import org.simantics.scl.compiler.constants.JavaStaticField;
+import org.simantics.scl.compiler.constants.JavaStaticMethod;
+import org.simantics.scl.compiler.constants.NoRepConstant;
+import org.simantics.scl.compiler.constants.SCLConstant;
+import org.simantics.scl.compiler.constants.SCLConstructor;
+import org.simantics.scl.compiler.constants.singletons.BindingConstant;
+import org.simantics.scl.compiler.constants.singletons.FailFunction;
+import org.simantics.scl.compiler.constants.singletons.JustConstant;
+import org.simantics.scl.compiler.constants.singletons.NothingConstant;
+import org.simantics.scl.compiler.constants.singletons.TypeOfConstant;
+import org.simantics.scl.compiler.constants.singletons.TypeOfProxyConstant;
+import org.simantics.scl.compiler.constants.singletons.TypeProxyConstant;
+import org.simantics.scl.compiler.elaboration.fundeps.Fundep;
+import org.simantics.scl.compiler.elaboration.modules.Documentation;
+import org.simantics.scl.compiler.elaboration.modules.SCLValue;
+import org.simantics.scl.compiler.elaboration.modules.TypeClass;
+import org.simantics.scl.compiler.errors.Locations;
+import org.simantics.scl.compiler.internal.codegen.effects.EffectConstructor;
+import org.simantics.scl.compiler.internal.codegen.references.BoundVar;
+import org.simantics.scl.compiler.internal.codegen.ssa.SSABlock;
+import org.simantics.scl.compiler.internal.codegen.ssa.SSAFunction;
+import org.simantics.scl.compiler.internal.codegen.ssa.exits.Jump;
+import org.simantics.scl.compiler.internal.codegen.ssa.statements.LetApply;
+import org.simantics.scl.compiler.internal.codegen.types.MaybeType;
+import org.simantics.scl.compiler.internal.codegen.types.StandardTypeConstructor;
+import org.simantics.scl.compiler.internal.codegen.types.VectorType;
+import org.simantics.scl.compiler.internal.codegen.utils.Constants;
+import org.simantics.scl.compiler.module.ConcreteModule;
+import org.simantics.scl.compiler.types.TApply;
+import org.simantics.scl.compiler.types.TCon;
+import org.simantics.scl.compiler.types.TFun;
+import org.simantics.scl.compiler.types.TPred;
+import org.simantics.scl.compiler.types.TUnion;
+import org.simantics.scl.compiler.types.TVar;
+import org.simantics.scl.compiler.types.Type;
+import org.simantics.scl.compiler.types.Types;
+import org.simantics.scl.compiler.types.kinds.Kind;
+import org.simantics.scl.compiler.types.kinds.Kinds;
+import org.simantics.scl.runtime.profiling.BranchPoint;
+
+public class Builtins extends ConcreteModule {
+
+ public static SCLValue[] TUPLE_CONSTRUCTORS = new SCLValue[Constants.MAX_TUPLE_LENGTH+1];
+ public static SCLValue[] LIST_CONSTRUCTORS = new SCLValue[Constants.MAX_LIST_LITERAL_LENGTH+1];
+
+ public static final Builtins INSTANCE = new Builtins();
+
+ public static SCLValue Nothing;
+ public static SCLValue Just;
+
+ private Builtins() {
+ super(Types.BUILTIN);
+
+ TVar A = Types.var(Kinds.STAR);
+
+ StandardTypeConstructor Boolean = new StandardTypeConstructor(Types.BOOLEAN, Kinds.STAR, TypeDesc.BOOLEAN);
+ Boolean.documentation = "Data type representing truth values `True` and `False`.";
+ addTypeConstructor("Boolean", Boolean);
+ addTypeConstructor("Byte", new StandardTypeConstructor(Types.BYTE, Kinds.STAR, TypeDesc.BYTE,
+ "8-bit signed integer"));
+ addTypeConstructor("Character", new StandardTypeConstructor(Types.CHARACTER, Kinds.STAR, TypeDesc.CHAR,
+ "16-bit Unicode character."));
+ addTypeConstructor("Short", new StandardTypeConstructor(Types.SHORT, Kinds.STAR, TypeDesc.SHORT,
+ "16-bit signed integer"));
+ addTypeConstructor("Integer", new StandardTypeConstructor(Types.INTEGER, Kinds.STAR, TypeDesc.INT,
+ "32-bit signed integer"));
+ addTypeConstructor("Long", new StandardTypeConstructor(Types.LONG, Kinds.STAR, TypeDesc.LONG,
+ "64-bit signed integer"));
+ addTypeConstructor("Float", new StandardTypeConstructor(Types.FLOAT, Kinds.STAR, TypeDesc.FLOAT,
+ "32-bit floating point number"));
+ addTypeConstructor("Double", new StandardTypeConstructor(Types.DOUBLE, Kinds.STAR, TypeDesc.DOUBLE,
+ "64-bit floating point number"));
+ addTypeConstructor("String", new StandardTypeConstructor(Types.STRING, Kinds.STAR, TypeDesc.STRING,
+ "Unicode string"));
+
+ addTypeConstructor("BooleanArray", new StandardTypeConstructor(Types.BOOLEAN_ARRAY, Kinds.STAR, TypeDesc.forClass(boolean[].class)));
+ addTypeConstructor("ByteArray", new StandardTypeConstructor(Types.BYTE_ARRAY, Kinds.STAR, TypeDesc.forClass(byte[].class)));
+ addTypeConstructor("CharacterArray", new StandardTypeConstructor(Types.CHARACTER_ARRAY, Kinds.STAR, TypeDesc.forClass(char[].class)));
+ addTypeConstructor("ShortArray", new StandardTypeConstructor(Types.SHORT_ARRAY, Kinds.STAR, TypeDesc.forClass(short[].class)));
+ addTypeConstructor("IntegerArray", new StandardTypeConstructor(Types.INTEGER_ARRAY, Kinds.STAR, TypeDesc.forClass(int[].class)));
+ addTypeConstructor("LongArray", new StandardTypeConstructor(Types.LONG_ARRAY, Kinds.STAR, TypeDesc.forClass(long[].class)));
+ addTypeConstructor("FloatArray", new StandardTypeConstructor(Types.FLOAT_ARRAY, Kinds.STAR, TypeDesc.forClass(float[].class)));
+ addTypeConstructor("DoubleArray", new StandardTypeConstructor(Types.DOUBLE_ARRAY, Kinds.STAR, TypeDesc.forClass(double[].class)));
+
+ addTypeConstructor("Array", new StandardTypeConstructor(Types.con(Types.BUILTIN, "Array"), Kinds.STAR_TO_STAR, TypeDesc.forClass(Object[].class)));
+
+ addTypeConstructor("Maybe", MaybeType.INSTANCE);
+
+ addTypeConstructor("Variant", new StandardTypeConstructor(Types.VARIANT, Kinds.STAR, TypeDesc.forClass(Variant.class)));
+
+ addEffectConstructor("Proc", new EffectConstructor(Types.PROC));
+
+ //addTypeConstructor("->", new StandardTypeConstructor(Kinds.STAR_TO_STAR_TO_STAR, Constants.FUNCTION));
+ addTypeConstructor("[]", new StandardTypeConstructor(Types.LIST, Kinds.STAR_TO_STAR, Constants.LIST));
+ addTypeConstructor("@", new StandardTypeConstructor(Types.PUNIT, Kinds.STAR, Constants.TUPLE[0]));
+ addTypeConstructor("TypeProxy", new StandardTypeConstructor(Types.TYPE_PROXY, Kinds.STAR_TO_STAR, Constants.TUPLE[0]));
+
+ // *** Tuples ***
+
+ Kind tupleKind = Kinds.STAR;
+ for(int arity=0;arity<=Constants.MAX_TUPLE_LENGTH;++arity) {
+ if(arity != 1) {
+ TVar[] vars = new TVar[arity];
+ for(int i=0;i<vars.length;++i)
+ vars[i] = Types.var(Kinds.STAR);
+ TCon constructor = Types.tupleConstructor(arity);
+ StandardTypeConstructor typeConstructor =
+ new StandardTypeConstructor(constructor, tupleKind, Constants.TUPLE[arity]);
+ addTypeConstructor(constructor.name, typeConstructor);
+ Type returnType = Types.apply(constructor, vars);
+ typeConstructor.setType(constructor, vars);
+ Constant cons;
+ String javaName = "org/simantics/scl/runtime/tuple/Tuple"+arity;
+ if(arity == 0) {
+ cons = new NoRepConstant(returnType);
+ typeConstructor.setConstructors(new Constructor(Locations.NO_LOCATION, typeConstructor,
+ Name.create(Types.BUILTIN, constructor.name),
+ vars, javaName)
+ );
+ }
+ else {
+ cons = new SCLConstructor(constructor.name,
+ javaName, vars, 0, returnType, vars);
+ typeConstructor.setConstructors(
+ new Constructor(Locations.NO_LOCATION, typeConstructor,
+ Name.create(Types.BUILTIN, constructor.name),
+ vars, javaName)
+ );
+ }
+ typeConstructor.isOpen = false;
+ SCLValue value = new SCLValue(Name.create(Types.BUILTIN, constructor.name), cons);
+ addValue(value);
+ TUPLE_CONSTRUCTORS[arity] = value;
+ }
+ tupleKind = Kinds.arrow(Kinds.STAR, tupleKind);
+ }
+
+ // *** Lists ***
+
+ for(int arity=0;arity<=Constants.MAX_LIST_LITERAL_LENGTH;++arity) {
+ LIST_CONSTRUCTORS[arity] = addValue("_list_literal_" + arity + "_",
+ arity == 0 ? new EmptyListConstructor() :
+ new ListConstructor(arity)
+ );
+ }
+
+ // *** Boolean ***
+
+ SCLValue True = addValue("True", new BooleanConstant(true));
+ SCLValue False = addValue("False", new BooleanConstant(false));
+ Boolean.setConstructors(
+ new Constructor(Locations.NO_LOCATION, Boolean, False.getName(), Type.EMPTY_ARRAY, null),
+ new Constructor(Locations.NO_LOCATION, Boolean, True.getName(), Type.EMPTY_ARRAY, null)
+ );
+ Boolean.isOpen = false;
+
+ // *** Maybe ***
+
+ Nothing = addValue("Nothing", NothingConstant.INSTANCE);
+ Just = addValue("Just", JustConstant.INSTANCE);
+ MaybeType.INSTANCE.setConstructors(
+ new Constructor(Locations.NO_LOCATION, MaybeType.INSTANCE, Nothing.getName(), Type.EMPTY_ARRAY, null),
+ new Constructor(Locations.NO_LOCATION, MaybeType.INSTANCE, Just.getName(), new Type[] {MaybeType.INSTANCE.parameters[0]}, null)
+ );
+
+ // *** Vector ***
+
+ TypeClass VecCompC = new TypeClass(Locations.NO_LOCATION,
+ TPred.EMPTY_ARRAY,
+ Types.VEC_COMP,
+ "java/lang/Class",
+ new TVar[] {A},
+ Fundep.EMPTY_ARRAY);
+ addTypeClass("VecComp", VecCompC);
+
+ addTypeConstructor("Vector", new VectorType(Types.VECTOR));
+ addValue("getVector", new GetVector(Types.NO_EFFECTS, Types.VECTOR));
+ addValue("lengthVector", new LengthVector(Types.VECTOR));
+ //addValue("createVectorFromList", CreateVectorFromList.INSTANCE);
+
+ addTypeConstructor("MVector", new VectorType(Types.MVECTOR));
+ addValue("createMVector", CreateMVector.INSTANCE);
+ addValue("createMVectorProto", CreateMVectorProto.INSTANCE);
+ addValue("getMVector", new GetVector(Types.PROC, Types.MVECTOR));
+ addValue("lengthMVector", new LengthVector(Types.MVECTOR));
+ addValue("freezeMVector", new FreezeMVector());
+ addValue("setMVector", SetMVector.INSTANCE);
+
+ // *** fail ***
+
+ addValue("fail", FailFunction.INSTANCE).documentation =
+ "Throws a runtime exeception with the given string as a description.";
+
+ // *** runProc ***
+
+ {
+ TVar a = Types.var(Kinds.STAR);
+ TVar e = Types.var(Kinds.EFFECT);
+ SSAFunction runProcFunction = new SSAFunction(new TVar[] {a,e}, e, a);
+ Type parameterType = Types.functionE(Types.PUNIT, Types.union(new Type[] {Types.PROC,e}), a);
+ SSABlock block = new SSABlock(parameterType);
+ BoundVar[] parameters = block.getParameters();
+
+ BoundVar x = new BoundVar(a);
+ LetApply apply = new LetApply(x, Types.PROC, parameters[0].createOccurrence(),
+ new NoRepConstant(Types.PUNIT).createOccurrence()
+ );
+ block.addStatement(apply);
+
+ block.setExit(new Jump(runProcFunction.getReturnCont().createOccurrence(),
+ x.createOccurrence()));
+
+ runProcFunction.addBlock(block);
+ SCLConstant runProc = new SCLConstant(Name.create(Types.BUILTIN, "runProc"), runProcFunction.getType());
+ runProc.setDefinition(runProcFunction);
+ runProc.setInlineArity(1, 0xffffffff);
+ runProc.setBase(new JavaStaticMethod("org/simantics/scl/runtime/procedure/Procedures",
+ "runProc", a, parameterType));
+ addValue("runProc", runProc);
+ }
+
+ // *** Typeable ***
+
+ {
+ /* class Typeable a
+ */
+ TypeClass TypeableC = new TypeClass(Locations.NO_LOCATION,
+ TPred.EMPTY_ARRAY,
+ Types.TYPEABLE,
+ Type.class.getName(),
+ new TVar[] {A},
+ Fundep.EMPTY_ARRAY);
+ TypeableC.documentation = "A class of types that can be reified with `typeOf` function.";
+ addTypeClass("Typeable", TypeableC);
+
+ /* data Type = TCon String String
+ * | TApply Type Type
+ */
+ final TCon Type = Types.con(Types.BUILTIN, "Type");
+ final TypeDesc TypeD = TypeDesc.forClass(Type.class);
+ addValue("TCon", new JavaStaticMethod(
+ Types.class.getName().replace('.', '/'),
+ "con",
+ TypeDesc.forClass(TCon.class), new TypeDesc[] {TypeDesc.STRING, TypeDesc.STRING},
+ Type, Types.STRING, Types.STRING));
+ addValue("TApply", new JavaStaticMethod(
+ "org/simantics/scl/compiler/types/Types",
+ "apply",
+ TypeDesc.forClass(TApply.class), new TypeDesc[] {TypeD, TypeD},
+ Type, Type, Type));
+ addValue("TFun", new JavaStaticMethod(
+ "org/simantics/scl/compiler/types/Types",
+ "functionE",
+ TypeDesc.forClass(TFun.class), new TypeDesc[] {TypeD, TypeD, TypeD},
+ Type, Type, Type, Type));
+ addValue("TPure", new JavaStaticField(
+ "org/simantics/scl/compiler/types/Types",
+ "NO_EFFECTS",
+ Types.NO_EFFECTS,
+ TypeDesc.forClass(TUnion.class),
+ Type, -1));
+ /*addValue("TUnion", new JavaStaticMethod(
+ "org/simantics/scl/compiler/types/Types",
+ "union",
+ Types.NO_EFFECTS,
+ Type, Types.list(Type)));*/
+
+ StandardTypeConstructor TypeC = new StandardTypeConstructor(Type, Kinds.STAR,
+ TypeDesc.forClass("org/simantics/scl/compiler/types/Type"));
+ TypeC.setType(Type);
+ TypeC.isOpen = true;
+ TypeC.documentation = "Represents an SCL data type.";
+ addTypeConstructor("Type", TypeC);
+
+ // typeOf :: Typeable a => a -> Type
+ addValue("typeOf", TypeOfConstant.INSTANCE)
+ .documentation = "Returns the type of the value given as a parameter.";
+ addValue("typeOfProxy", TypeOfProxyConstant.INSTANCE)
+ .documentation = "Returns the type of the type proxy given as a parameter.";
+ addValue("TypeProxy", TypeProxyConstant.INSTANCE);
+ }
+
+ // *** Serializable ***
+
+ {
+ /* class Serializable a
+ */
+ TypeClass SerializableC = new TypeClass(Locations.NO_LOCATION,
+ TPred.EMPTY_ARRAY,
+ Types.SERIALIZABLE,
+ "org/simantics/databoard/binding/Binding",
+ new TVar[] {A},
+ Fundep.EMPTY_ARRAY);
+ SerializableC.documentation = "A class of types having a `Binding`";
+ addTypeClass("Serializable", SerializableC);
+
+ /* data TypeRep = TCon String
+ * | TApply TypeRep TypeRep
+ */
+
+ StandardTypeConstructor BindingC = new StandardTypeConstructor(Types.BINDING, Kinds.STAR_TO_STAR,
+ TypeDesc.forClass("org/simantics/databoard/binding/Binding"));
+ BindingC.setType(Types.BINDING, A);
+ BindingC.documentation = "`Binding` represents a data type in the form supported by Databoard library. " +
+ "It is used to serialize and deserialize values.";
+ addTypeConstructor("Binding", BindingC);
+
+ // typeOf :: Typeable a => a -> TypeReps
+ addValue("binding", BindingConstant.INSTANCE)
+ .documentation = "Gives a binding for the required type.";
+
+ }
+
+ // Relations
+
+ {
+ addRelation("Eq", EqRelation.INSTANCE);
+ addRelation("Optional", OptionalRelation.INSTANCE);
+ addRelation("Execute", new ExecuteRelation(0));
+ addRelation("Execute10", new ExecuteRelation(10));
+ }
+
+ addValue("newEq", EqualsFunction.INSTANCE);
+ addValue("newHash", HashCodeFunction.INSTANCE);
+ // Coverage
+ {
+ StandardTypeConstructor branchPoint = new StandardTypeConstructor(Types.BRANCH_POINT, Kinds.STAR,
+ TypeDesc.forClass(BranchPoint.class));
+ addTypeConstructor("BranchPoint", branchPoint);
+
+ addValue("visitBranchPoint", VisitBranchPoint.INSTANCE);
+ }
+ }
+
+ @Override
+ public Documentation getDocumentation() {
+ return documentation;
+ }
+
+}